home *** CD-ROM | disk | FTP | other *** search
/ Clickx 115 / Clickx 115.iso / software / tools / windows / tails-i386-0.16.iso / live / filesystem.squashfs / usr / lib / perl5 / Net / SSLeay.pm < prev   
Encoding:
Perl POD Document  |  2010-03-07  |  89.0 KB  |  2,694 lines

  1. # Net::SSLeay.pm - Perl module for using Eric Young's implementation of SSL
  2. #
  3. # Copyright (c) 1996-2003 Sampo Kellomaki <sampo@iki.fi>, All Rights Reserved.
  4. # Copyright (C) 2005 Florian Ragwitz <rafl@debian.org>, All Rights Reserved.
  5. # Copyright (C) 2005 Mike McCauley <mikem@open.com.au>, All Rights Reserved.
  6. #
  7. # $Id$
  8. #
  9. # Version 1.04, 31.3.1999
  10. # 30.7.1999, Tracking OpenSSL-0.9.3a changes, --Sampo
  11. # 31.7.1999, version 1.05 --Sampo
  12. # 7.4.2001,  fixed input error upon 0, OpenSSL-0.9.6a, version 1.06 --Sampo
  13. # 18.4.2001, added TLSv1 support by Stephen C. Koehler
  14. #            <koehler@securecomputing.com>, version 1.07, --Sampo
  15. # 25.4.2001, 64 bit fixes by Marko Asplund <aspa@kronodoc.fi> --Sampo
  16. # 17.4.2001, more error codes from aspa --Sampo
  17. # 25.9.2001, added heaps and piles of newer OpenSSL auxiliary functions --Sampo
  18. # 6.11.2001, got rid of $p_errs madness --Sampo
  19. # 9.11.2001, added EGD (entropy gathering daemon) reference info --Sampo
  20. # 7.12.2001, Added proxy support by Bruno De Wolf <bruno.dewolf@@pandora._be>
  21. # 6.1.2002,  cosmetic fix to socket options from Kwindla Hultman Kramer <kwindla@@allafrica_.com>
  22. # 25.3.2002, added post_https_cert and friends per patch from
  23. #            mock@@obscurity.ogr, --Sampo
  24. # 3.4.2002,  added `use bytes' from Marcus Taylor <marcus@@semantico_.com>
  25. #            This avoids unicode/utf8 (as may appear in some XML docs)
  26. #            from fooling the length comuptations. Dropped support for
  27. #            perl5.005_03 because I do not have opportunity to test it. --Sampo
  28. # 5.4.2002,  improved Unicode gotcha eliminator to support old perls --Sampo
  29. # 8.4.2002,  added a small line end fix from Petr Dousa (pdousa@@kerio_.com)
  30. # 17.5.2002, Added BIO_s_mem, BIO_new, BIO_free, BIO_write, BIO_read 
  31. #            BIO_eof, BIO_pending, BIO_wpending, RSA_generate_key, RSA_free
  32. #            --mikem@open._com.au
  33. # 10.8.2002, Added SSL_peek patch to ssl_read_until from 
  34. #            Peter Behroozi <peter@@fhpwireless_.com> --Sampo
  35. # 21.8.2002, Added SESSION_get_master_key, SSL_get_client_random, SSL_get_server_random
  36. #            --mikem@open.com_.au
  37. # 2.9.2002,  Added SSL_CTX_get_cert_store, X509_STORE_add_cert, X509_STORE_add_crl
  38. #            X509_STORE_set_flags, X509_load_cert_file, X509_load_crl_file
  39. #            X509_load_cert_crl_file, PEM_read_bio_X509_CRL,
  40. #            constants for X509_V_FLAG_* in order to support certificate revocation lists.
  41. #            --mikem@open.com_.au
  42. # 6.9.2002,  fixed X509_STORE_set_flags to X509_STORE_CTX_set_flags, --Sampo
  43. # 19.9.2002, applied patch from Tim Engler <tim@burntcouch_.com>
  44. # 18.2.2003, applied patch from Toni Andjelkovic <toni@soth._at>
  45. # 13.6.2003, partially applied leak patch by Marian Jancar <mjancar@suse._cz>
  46. # 25.6.2003, write_partial() return value patch from 
  47. #            Kim Minh Kaplan <kmkaplan@selfoffice._com>
  48. # 17.8.2003, added http support :-) --Sampo
  49. # 17.8.2003, started 1.25 dev --Sampo
  50. # 30.11.2005, Applied a patch by Peter Behroozi that adds get1_session() for session caching --Florian
  51. # 30.11.2005, Applied a patch by ex8k-hbn@asahi-net.or.jp that limits the chunk size for tcp_read_all --Florian
  52. # 30.11.2005, Applied a patch by ivan-cpan-rt@420.am that avoids adding a Host header if an own is specified in do_httpx3
  53. # 13.12.2005, Added comments re thread safety and resetting of default_passwd_callback after use 
  54. #             --mikem@open.com.au
  55. #
  56. # The distribution and use of this module are subject to the conditions
  57. # listed in LICENSE file at the root of OpenSSL-0.9.7b
  58. # distribution (i.e. free, but mandatory attribution and NO WARRANTY).
  59.  
  60. package Net::SSLeay;
  61.  
  62. use strict;
  63. use Carp;
  64. use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $AUTOLOAD $CRLF);
  65. use Socket;
  66. use Errno;
  67.  
  68. require Exporter;
  69. use AutoLoader;
  70.  
  71. # 0=no warns, 1=only errors, 2=ciphers, 3=progress, 4=dump data
  72. $Net::SSLeay::trace = 0;  # Do not change here, use
  73.                           # $Net::SSLeay::trace = [1-4]  in caller
  74.  
  75. # 2 = insist on v2 SSL protocol
  76. # 3 = insist on v3 SSL
  77. # 10 = insist on TLSv1
  78. # 0 or undef = guess (v23)
  79. #
  80. $Net::SSLeay::ssl_version = 0;  # don't change here, use 
  81.                                 # Net::SSLeay::version=[2,3,0] in caller
  82.  
  83. #define to enable the "cat /proc/$$/stat" stuff
  84. $Net::SSLeay::linux_debug = 0;
  85.  
  86. # Number of seconds to sleep after sending message and before half
  87. # closing connection. Useful with antiquated broken servers.
  88. $Net::SSLeay::slowly = 0;
  89.  
  90. # RANDOM NUMBER INITIALIZATION
  91. #
  92. # Edit to your taste. Using /dev/random would be more secure, but may
  93. # block if randomness is not available, thus the default is
  94. # /dev/urandom. $how_random determines how many bits of randomness to take
  95. # from the device. You should take enough (read SSLeay/doc/rand), but
  96. # beware that randomness is limited resource so you should not waste
  97. # it either or you may end up with randomness depletion (situation where
  98. # /dev/random would block and /dev/urandom starts to return predictable
  99. # numbers).
  100. #
  101. # N.B. /dev/urandom does not exit on all systems, such as Solaris 2.6. In that
  102. #      case you should get a third party package that emulates /dev/urandom
  103. #      (e.g. via named pipe) or supply a random number file. Some such
  104. #      packages are documented in Caveat section of the POD documentation.
  105.  
  106. $Net::SSLeay::random_device = '/dev/urandom';
  107. $Net::SSLeay::how_random = 512;
  108.  
  109. $VERSION = '1.36';
  110. @ISA = qw(Exporter);
  111. @EXPORT_OK = qw(
  112.     AT_MD5_WITH_RSA_ENCRYPTION
  113.     CB_ACCEPT_EXIT
  114.     CB_ACCEPT_LOOP
  115.     CB_CONNECT_EXIT
  116.     CB_CONNECT_LOOP
  117.     CK_DES_192_EDE3_CBC_WITH_MD5
  118.     CK_DES_192_EDE3_CBC_WITH_SHA
  119.     CK_DES_64_CBC_WITH_MD5
  120.     CK_DES_64_CBC_WITH_SHA
  121.     CK_DES_64_CFB64_WITH_MD5_1
  122.     CK_IDEA_128_CBC_WITH_MD5
  123.     CK_NULL
  124.     CK_NULL_WITH_MD5
  125.     CK_RC2_128_CBC_EXPORT40_WITH_MD5
  126.     CK_RC2_128_CBC_WITH_MD5
  127.     CK_RC4_128_EXPORT40_WITH_MD5
  128.     CK_RC4_128_WITH_MD5
  129.     CLIENT_VERSION
  130.     ERROR_NONE
  131.     ERROR_SSL
  132.     ERROR_SYSCALL
  133.     ERROR_WANT_CONNECT
  134.     ERROR_WANT_READ
  135.     ERROR_WANT_WRITE
  136.     ERROR_WANT_X509_LOOKUP
  137.     ERROR_ZERO_RETURN
  138.     CT_X509_CERTIFICATE
  139.     FILETYPE_ASN1
  140.     FILETYPE_PEM
  141.     F_CLIENT_CERTIFICATE
  142.     F_CLIENT_HELLO
  143.     F_CLIENT_MASTER_KEY
  144.     F_D2I_SSL_SESSION
  145.     F_GET_CLIENT_FINISHED
  146.     F_GET_CLIENT_HELLO
  147.     F_GET_CLIENT_MASTER_KEY
  148.     F_GET_SERVER_FINISHED
  149.     F_GET_SERVER_HELLO
  150.     F_GET_SERVER_VERIFY
  151.     F_I2D_SSL_SESSION
  152.     F_READ_N
  153.     F_REQUEST_CERTIFICATE
  154.     F_SERVER_HELLO
  155.     F_SSL_ACCEPT
  156.     F_SSL_CERT_NEW
  157.     F_SSL_CONNECT
  158.     F_SSL_ENC_DES_CBC_INIT
  159.     F_SSL_ENC_DES_CFB_INIT
  160.     F_SSL_ENC_DES_EDE3_CBC_INIT
  161.     F_SSL_ENC_IDEA_CBC_INIT
  162.     F_SSL_ENC_NULL_INIT
  163.     F_SSL_ENC_RC2_CBC_INIT
  164.     F_SSL_ENC_RC4_INIT
  165.     F_SSL_GET_NEW_SESSION
  166.     F_SSL_MAKE_CIPHER_LIST
  167.     F_SSL_NEW
  168.     F_SSL_READ
  169.     F_SSL_RSA_PRIVATE_DECRYPT
  170.     F_SSL_RSA_PUBLIC_ENCRYPT
  171.     F_SSL_SESSION_NEW
  172.     F_SSL_SESSION_PRINT_FP
  173.     F_SSL_SET_CERTIFICATE
  174.     F_SSL_SET_FD
  175.     F_SSL_SET_RFD
  176.     F_SSL_SET_WFD
  177.     F_SSL_STARTUP
  178.     F_SSL_USE_CERTIFICATE
  179.     F_SSL_USE_CERTIFICATE_ASN1
  180.     F_SSL_USE_CERTIFICATE_FILE
  181.     F_SSL_USE_PRIVATEKEY
  182.     F_SSL_USE_PRIVATEKEY_ASN1
  183.     F_SSL_USE_PRIVATEKEY_FILE
  184.     F_SSL_USE_RSAPRIVATEKEY
  185.     F_SSL_USE_RSAPRIVATEKEY_ASN1
  186.     F_SSL_USE_RSAPRIVATEKEY_FILE
  187.     F_WRITE_PENDING
  188.     GEN_OTHERNAME
  189.     GEN_EMAIL
  190.     GEN_DNS
  191.     GEN_X400
  192.     GEN_DIRNAME
  193.     GEN_EDIPARTY
  194.     GEN_URI
  195.     GEN_IPADD
  196.     GEN_RID
  197.     MAX_MASTER_KEY_LENGTH_IN_BITS
  198.     MAX_RECORD_LENGTH_2_BYTE_HEADER
  199.     MAX_RECORD_LENGTH_3_BYTE_HEADER
  200.     MAX_SSL_SESSION_ID_LENGTH_IN_BYTES
  201.     MIN_RSA_MODULUS_LENGTH_IN_BYTES
  202.     MT_CLIENT_CERTIFICATE
  203.     MT_CLIENT_FINISHED
  204.     MT_CLIENT_HELLO
  205.     MT_CLIENT_MASTER_KEY
  206.     MT_ERROR
  207.     MT_REQUEST_CERTIFICATE
  208.     MT_SERVER_FINISHED
  209.     MT_SERVER_HELLO
  210.     MT_SERVER_VERIFY
  211.     NOTHING
  212.     NID_undef
  213.     NID_algorithm
  214.     NID_rsadsi
  215.     NID_pkcs
  216.     NID_md2
  217.     NID_md5
  218.     NID_rc4
  219.     NID_rsaEncryption
  220.     NID_md2WithRSAEncryption
  221.     NID_md5WithRSAEncryption
  222.     NID_pbeWithMD2AndDES_CBC
  223.     NID_pbeWithMD5AndDES_CBC
  224.     NID_X500
  225.     NID_X509
  226.     NID_commonName
  227.     NID_countryName
  228.     NID_localityName
  229.     NID_stateOrProvinceName
  230.     NID_organizationName
  231.     NID_organizationalUnitName
  232.     NID_rsa
  233.     NID_pkcs7
  234.     NID_pkcs7_data
  235.     NID_pkcs7_signed
  236.     NID_pkcs7_enveloped
  237.     NID_pkcs7_signedAndEnveloped
  238.     NID_pkcs7_digest
  239.     NID_pkcs7_encrypted
  240.     NID_pkcs3
  241.     NID_dhKeyAgreement
  242.     NID_des_ecb
  243.     NID_des_cfb64
  244.     NID_des_cbc
  245.     NID_des_ede
  246.     NID_des_ede3
  247.     NID_idea_cbc
  248.     NID_idea_cfb64
  249.     NID_idea_ecb
  250.     NID_rc2_cbc
  251.     NID_rc2_ecb
  252.     NID_rc2_cfb64
  253.     NID_rc2_ofb64
  254.     NID_sha
  255.     NID_shaWithRSAEncryption
  256.     NID_des_ede_cbc
  257.     NID_des_ede3_cbc
  258.     NID_des_ofb64
  259.     NID_idea_ofb64
  260.     NID_pkcs9
  261.     NID_pkcs9_emailAddress
  262.     NID_pkcs9_unstructuredName
  263.     NID_pkcs9_contentType
  264.     NID_pkcs9_messageDigest
  265.     NID_pkcs9_signingTime
  266.     NID_pkcs9_countersignature
  267.     NID_pkcs9_challengePassword
  268.     NID_pkcs9_unstructuredAddress
  269.     NID_pkcs9_extCertAttributes
  270.     NID_netscape
  271.     NID_netscape_cert_extension
  272.     NID_netscape_data_type
  273.     NID_des_ede_cfb64
  274.     NID_des_ede3_cfb64
  275.     NID_des_ede_ofb64
  276.     NID_des_ede3_ofb64
  277.     NID_sha1
  278.     NID_sha1WithRSAEncryption
  279.     NID_dsaWithSHA
  280.     NID_dsa_2
  281.     NID_pbeWithSHA1AndRC2_CBC
  282.     NID_id_pbkdf2
  283.     NID_dsaWithSHA1_2
  284.     NID_netscape_cert_type
  285.     NID_netscape_base_url
  286.     NID_netscape_revocation_url
  287.     NID_netscape_ca_revocation_url
  288.     NID_netscape_renewal_url
  289.     NID_netscape_ca_policy_url
  290.     NID_netscape_ssl_server_name
  291.     NID_netscape_comment
  292.     NID_netscape_cert_sequence
  293.     NID_desx_cbc
  294.     NID_id_ce
  295.     NID_subject_key_identifier
  296.     NID_key_usage
  297.     NID_private_key_usage_period
  298.     NID_subject_alt_name
  299.     NID_issuer_alt_name
  300.     NID_basic_constraints
  301.     NID_crl_number
  302.     NID_certificate_policies
  303.     NID_authority_key_identifier
  304.     NID_bf_cbc
  305.     NID_bf_ecb
  306.     NID_bf_cfb64
  307.     NID_bf_ofb64
  308.     NID_mdc2
  309.     NID_mdc2WithRSA
  310.     NID_rc4_40
  311.     NID_rc2_40_cbc
  312.     NID_givenName
  313.     NID_surname
  314.     NID_initials
  315.     NID_uniqueIdentifier
  316.     NID_crl_distribution_points
  317.     NID_md5WithRSA
  318.     NID_serialNumber
  319.     NID_title
  320.     NID_description
  321.     NID_cast5_cbc
  322.     NID_cast5_ecb
  323.     NID_cast5_cfb64
  324.     NID_cast5_ofb64
  325.     NID_pbeWithMD5AndCast5_CBC
  326.     NID_dsaWithSHA1
  327.     NID_md5_sha1
  328.     NID_sha1WithRSA
  329.     NID_dsa
  330.     NID_ripemd160
  331.     NID_ripemd160WithRSA
  332.     NID_rc5_cbc
  333.     NID_rc5_ecb
  334.     NID_rc5_cfb64
  335.     NID_rc5_ofb64
  336.     NID_rle_compression
  337.     NID_zlib_compression
  338.     NID_ext_key_usage
  339.     NID_id_pkix
  340.     NID_id_kp
  341.     NID_server_auth
  342.     NID_client_auth
  343.     NID_code_sign
  344.     NID_email_protect
  345.     NID_time_stamp
  346.     NID_ms_code_ind
  347.     NID_ms_code_com
  348.     NID_ms_ctl_sign
  349.     NID_ms_sgc
  350.     NID_ms_efs
  351.     NID_ns_sgc
  352.     NID_delta_crl
  353.     NID_crl_reason
  354.     NID_invalidity_date
  355.     NID_sxnet
  356.     NID_pbe_WithSHA1And128BitRC4
  357.     NID_pbe_WithSHA1And40BitRC4
  358.     NID_pbe_WithSHA1And3_Key_TripleDES_CBC
  359.     NID_pbe_WithSHA1And2_Key_TripleDES_CBC
  360.     NID_pbe_WithSHA1And128BitRC2_CBC
  361.     NID_pbe_WithSHA1And40BitRC2_CBC
  362.     NID_keyBag
  363.     NID_pkcs8ShroudedKeyBag
  364.     NID_certBag
  365.     NID_crlBag
  366.     NID_secretBag
  367.     NID_safeContentsBag
  368.     NID_friendlyName
  369.     NID_localKeyID
  370.     NID_x509Certificate
  371.     NID_sdsiCertificate
  372.     NID_x509Crl
  373.     NID_pbes2
  374.     NID_pbmac1
  375.     NID_hmacWithSHA1
  376.     NID_id_qt_cps
  377.     NID_id_qt_unotice
  378.     NID_rc2_64_cbc
  379.     NID_SMIMECapabilities
  380.     NID_pbeWithMD2AndRC2_CBC
  381.     NID_pbeWithMD5AndRC2_CBC
  382.     NID_pbeWithSHA1AndDES_CBC
  383.     NID_ms_ext_req
  384.     NID_ext_req
  385.     NID_name
  386.     NID_dnQualifier
  387.     NID_id_pe
  388.     NID_id_ad
  389.     NID_info_access
  390.     NID_ad_OCSP
  391.     NID_ad_ca_issuers
  392.     NID_OCSP_sign
  393.     OPENSSL_VERSION_NUMBER
  394.     PE_BAD_CERTIFICATE
  395.     PE_NO_CERTIFICATE
  396.     PE_NO_CIPHER
  397.     PE_UNSUPPORTED_CERTIFICATE_TYPE
  398.     READING
  399.     RECEIVED_SHUTDOWN
  400.     RWERR_BAD_MAC_DECODE
  401.     RWERR_BAD_WRITE_RETRY
  402.     RWERR_INTERNAL_ERROR
  403.     R_BAD_AUTHENTICATION_TYPE
  404.     R_BAD_CHECKSUM
  405.     R_BAD_MAC_DECODE
  406.     R_BAD_RESPONSE_ARGUMENT
  407.     R_BAD_SSL_FILETYPE
  408.     R_BAD_SSL_SESSION_ID_LENGTH
  409.     R_BAD_STATE
  410.     R_BAD_WRITE_RETRY
  411.     R_CHALLENGE_IS_DIFFERENT
  412.     R_CIPHER_CODE_TOO_LONG
  413.     R_CIPHER_TABLE_SRC_ERROR
  414.     R_CONECTION_ID_IS_DIFFERENT
  415.     R_INVALID_CHALLENGE_LENGTH
  416.     R_NO_CERTIFICATE_SET
  417.     R_NO_CERTIFICATE_SPECIFIED
  418.     R_NO_CIPHER_LIST
  419.     R_NO_CIPHER_MATCH
  420.     R_NO_CIPHER_WE_TRUST
  421.     R_NO_PRIVATEKEY
  422.     R_NO_PUBLICKEY
  423.     R_NO_READ_METHOD_SET
  424.     R_NO_WRITE_METHOD_SET
  425.     R_NULL_SSL_CTX
  426.     R_PEER_DID_NOT_RETURN_A_CERTIFICATE
  427.     R_PEER_ERROR
  428.     R_PEER_ERROR_CERTIFICATE
  429.     R_PEER_ERROR_NO_CIPHER
  430.     R_PEER_ERROR_UNSUPPORTED_CERTIFICATE_TYPE
  431.     R_PERR_ERROR_NO_CERTIFICATE
  432.     R_PUBLIC_KEY_ENCRYPT_ERROR
  433.     R_PUBLIC_KEY_IS_NOT_RSA
  434.     R_PUBLIC_KEY_NO_RSA
  435.     R_READ_WRONG_PACKET_TYPE
  436.     R_REVERSE_KEY_ARG_LENGTH_IS_WRONG
  437.     R_REVERSE_MASTER_KEY_LENGTH_IS_WRONG
  438.     R_REVERSE_SSL_SESSION_ID_LENGTH_IS_WRONG
  439.     R_SHORT_READ
  440.     R_SSL_SESSION_ID_IS_DIFFERENT
  441.     R_UNABLE_TO_EXTRACT_PUBLIC_KEY
  442.     R_UNDEFINED_INIT_STATE
  443.     R_UNKNOWN_REMOTE_ERROR_TYPE
  444.     R_UNKNOWN_STATE
  445.     R_UNSUPORTED_CIPHER
  446.     R_WRONG_PUBLIC_KEY_TYPE
  447.     R_X509_LIB
  448.     RSA_3
  449.     RSA_F4
  450.     SENT_SHUTDOWN
  451.     SERVER_VERSION
  452.     SESSION
  453.     SESSION_ASN1_VERSION
  454.     ST_ACCEPT
  455.     ST_BEFORE
  456.     ST_CLIENT_START_ENCRYPTION
  457.     ST_CONNECT
  458.     ST_GET_CLIENT_FINISHED_A
  459.     ST_GET_CLIENT_FINISHED_B
  460.     ST_GET_CLIENT_HELLO_A
  461.     ST_GET_CLIENT_HELLO_B
  462.     ST_GET_CLIENT_MASTER_KEY_A
  463.     ST_GET_CLIENT_MASTER_KEY_B
  464.     ST_GET_SERVER_FINISHED_A
  465.     ST_GET_SERVER_FINISHED_B
  466.     ST_GET_SERVER_HELLO_A
  467.     ST_GET_SERVER_HELLO_B
  468.     ST_GET_SERVER_VERIFY_A
  469.     ST_GET_SERVER_VERIFY_B
  470.     ST_INIT
  471.     ST_OK
  472.     ST_READ_BODY
  473.     ST_READ_HEADER
  474.     ST_SEND_CLIENT_CERTIFICATE_A
  475.     ST_SEND_CLIENT_CERTIFICATE_B
  476.     ST_SEND_CLIENT_CERTIFICATE_C
  477.     ST_SEND_CLIENT_CERTIFICATE_D
  478.     ST_SEND_CLIENT_FINISHED_A
  479.     ST_SEND_CLIENT_FINISHED_B
  480.     ST_SEND_CLIENT_HELLO_A
  481.     ST_SEND_CLIENT_HELLO_B
  482.     ST_SEND_CLIENT_MASTER_KEY_A
  483.     ST_SEND_CLIENT_MASTER_KEY_B
  484.     ST_SEND_REQUEST_CERTIFICATE_A
  485.     ST_SEND_REQUEST_CERTIFICATE_B
  486.     ST_SEND_REQUEST_CERTIFICATE_C
  487.     ST_SEND_REQUEST_CERTIFICATE_D
  488.     ST_SEND_SERVER_FINISHED_A
  489.     ST_SEND_SERVER_FINISHED_B
  490.     ST_SEND_SERVER_HELLO_A
  491.     ST_SEND_SERVER_HELLO_B
  492.     ST_SEND_SERVER_VERIFY_A
  493.     ST_SEND_SERVER_VERIFY_B
  494.     ST_SERVER_START_ENCRYPTION
  495.     ST_X509_GET_CLIENT_CERTIFICATE
  496.     ST_X509_GET_SERVER_CERTIFICATE
  497.     TXT_DES_192_EDE3_CBC_WITH_MD5
  498.     TXT_DES_192_EDE3_CBC_WITH_SHA
  499.     TXT_DES_64_CBC_WITH_MD5
  500.     TXT_DES_64_CBC_WITH_SHA
  501.     TXT_DES_64_CFB64_WITH_MD5_1
  502.     TXT_IDEA_128_CBC_WITH_MD5
  503.     TXT_NULL
  504.     TXT_NULL_WITH_MD5
  505.     TXT_RC2_128_CBC_EXPORT40_WITH_MD5
  506.     TXT_RC2_128_CBC_WITH_MD5
  507.     TXT_RC4_128_EXPORT40_WITH_MD5
  508.     TXT_RC4_128_WITH_MD5
  509.     VERIFY_CLIENT_ONCE
  510.     VERIFY_FAIL_IF_NO_PEER_CERT
  511.     VERIFY_NONE
  512.     VERIFY_PEER
  513.     WRITING
  514.     X509_LOOKUP
  515.     X509_V_FLAG_CB_ISSUER_CHECK
  516.     X509_V_FLAG_USE_CHECK_TIME
  517.     X509_V_FLAG_CRL_CHECK
  518.     X509_V_FLAG_CRL_CHECK_ALL
  519.     X509_V_FLAG_IGNORE_CRITICAL
  520.     CTX_new
  521.     CTX_v2_new
  522.     CTX_v3_new
  523.     CTX_v23_new
  524.     CTX_free
  525.     new
  526.     free
  527.     accept
  528.     clear
  529.     connect
  530.     set_fd
  531.     set_rfd
  532.     set_wfd
  533.     get_fd
  534.     read
  535.     write
  536.     peek
  537.     use_RSAPrivateKey
  538.     use_RSAPrivateKey_ASN1
  539.     use_RSAPrivateKey_file
  540.     CTX_use_RSAPrivateKey_file
  541.     use_PrivateKey
  542.     use_PrivateKey_ASN1
  543.     use_PrivateKey_file
  544.     use_certificate
  545.     use_certificate_ASN1
  546.     use_certificate_file
  547.     CTX_use_certificate_file
  548.     load_error_strings
  549.     ERR_load_SSL_strings
  550.     ERR_load_RAND_strings
  551.     state_string
  552.     rstate_string
  553.     state_string_long
  554.     rstate_string_long
  555.     get_time
  556.     set_time
  557.     get_timeout
  558.     set_timeout
  559.     copy_session_id
  560.     set_read_ahead
  561.     get_read_ahead
  562.     pending
  563.     get_cipher_list
  564.     set_cipher_list
  565.     get_cipher
  566.     get_shared_ciphers
  567.     get_peer_certificate
  568.     set_verify
  569.     flush_sessions
  570.     set_bio
  571.     get_rbio
  572.     get_wbio
  573.     SESSION_new
  574.     SESSION_print
  575.     SESSION_free
  576.     i2d_SSL_SESSION
  577.     set_session
  578.     add_session
  579.     remove_session
  580.     d2i_SSL_SESSION
  581.     BIO_f_ssl
  582.     BIO_new
  583.     BIO_new_file
  584.     BIO_s_mem
  585.     BIO_free
  586.     BIO_read
  587.     BIO_write
  588.     BIO_eof
  589.     BIO_pending
  590.     BIO_wpending
  591.     ERR_get_error
  592.     ERR_error_string
  593.     err
  594.     clear_error
  595.     X509_get_issuer_name
  596.     X509_get_subject_name
  597.     X509_NAME_oneline
  598.     X509_NAME_get_text_by_NID
  599.     CTX_get_cert_store
  600.     X509_STORE_add_cert
  601.     X509_STORE_add_crl
  602.     X509_STORE_CTX_set_flags
  603.     X509_load_cert_file
  604.     X509_load_crl_file
  605.     X509_load_cert_crl_file
  606.     PEM_read_bio_X509_CRL
  607.     die_if_ssl_error
  608.     die_now
  609.     print_errs
  610.     set_cert_and_key
  611.     set_server_cert_and_key
  612.     make_form
  613.     make_headers
  614.     do_https
  615.     get_https
  616.     post_https
  617.     get_https4
  618.     post_https4
  619.     sslcat
  620.     ssl_read_CRLF
  621.     ssl_read_all
  622.     ssl_read_until
  623.     ssl_write_CRLF
  624.     ssl_write_all
  625.     get_http
  626.     post_http
  627.     get_httpx
  628.     post_httpx
  629.     get_https3
  630.     post_https3
  631.     get_http4
  632.     post_http4
  633.     get_httpx4
  634.     post_httpx4
  635.     tcpcat
  636.     tcpxcat
  637.     tcp_read_CRLF
  638.     tcp_read_all
  639.     tcp_read_until
  640.     tcp_write_CRLF
  641.     tcp_write_all
  642.     dump_peer_certificate
  643.     RSA_generate_key
  644.     RSA_free
  645.     X509_free
  646.     SESSION_get_master_key
  647.     get_client_random
  648.     get_server_random
  649. );
  650.  
  651. sub AUTOLOAD {
  652.     # This AUTOLOAD is used to 'autoload' constants from the constant()
  653.     # XS function.  If a constant is not found then control is passed
  654.     # to the AUTOLOAD in AutoLoader.
  655.  
  656.     my $constname;
  657.     ($constname = $AUTOLOAD) =~ s/.*:://;
  658.     my $val = constant($constname);
  659.     if ($! != 0) {
  660.     if ($! =~ /((Invalid)|(not valid))/i || $!{EINVAL}) {
  661.         $AutoLoader::AUTOLOAD = $AUTOLOAD;
  662.         goto &AutoLoader::AUTOLOAD;
  663.     }
  664.     else {
  665.       croak "Your vendor has not defined SSLeay macro $constname";
  666.     }
  667.     }
  668.     eval "sub $AUTOLOAD { $val }";
  669.     goto &$AUTOLOAD;
  670. }
  671.  
  672. eval {
  673.     require XSLoader;
  674.     XSLoader::load('Net::SSLeay', $VERSION);
  675.     1;
  676. } or do {
  677.     require DynaLoader;
  678.     push @ISA, 'DynaLoader';
  679.     bootstrap Net::SSLeay $VERSION;
  680. };
  681.  
  682. # Preloaded methods go here.
  683.  
  684. $CRLF = "\x0d\x0a";  # because \r\n is not fully portable
  685.  
  686. ### Print SSLeay error stack
  687.  
  688. sub print_errs {
  689.     my ($msg) = @_;
  690.     my ($count, $err, $errs, $e) = (0,0,'');
  691.     while ($err = ERR_get_error()) {
  692.         $count ++;
  693.     $e = "$msg $$: $count - " . ERR_error_string($err) . "\n";
  694.     $errs .= $e;
  695.     warn $e if $Net::SSLeay::trace;
  696.     }
  697.     return $errs;
  698. }
  699.  
  700. # Death is conditional to SSLeay errors existing, i.e. this function checks
  701. # for errors and only dies in affirmative.
  702. # usage: Net::SSLeay::write($ssl, "foo") or die_if_ssl_error("SSL write ($!)");
  703.  
  704. sub die_if_ssl_error {
  705.     my ($msg) = @_;    
  706.     die "$$: $msg\n" if print_errs($msg);
  707. }
  708.  
  709. # Unconditional death. Used to print SSLeay errors before dying.
  710. # usage: Net::SSLeay::connect($ssl) or die_now("Failed SSL connect ($!)");
  711.  
  712. sub die_now {
  713.     my ($msg) = @_;    
  714.     print_errs($msg);
  715.     die "$$: $msg\n";
  716. }
  717.  
  718. # Perl 5.6.* unicode support causes that length() no longer reliably
  719. # reflects the byte length of a string. This eval is to fix that.
  720. # Thanks to Sean Burke for the snippet.
  721.  
  722. BEGIN{ 
  723. eval 'use bytes; sub blength ($) { length $_[0] }'; 
  724. $@ and eval '    sub blength ($) { length $_[0] }' ; 
  725. }
  726.  
  727. # Autoload methods go after =cut, and are processed by the autosplit program.
  728.  
  729. 1;
  730. __END__
  731. # Documentation. Use `perl-root/pod/pod2html SSLeay.pm` to output html
  732.  
  733. =head1 NAME
  734.  
  735. Net::SSLeay - Perl extension for using OpenSSL
  736.  
  737. =head1 SYNOPSIS
  738.  
  739.   use Net::SSLeay qw(get_https post_https sslcat make_headers make_form);
  740.  
  741.   ($page) = get_https('www.bacus.pt', 443, '/');                 # 1
  742.  
  743.   ($page, $response, %reply_headers)
  744.      = get_https('www.bacus.pt', 443, '/',                   # 2
  745.          make_headers(User-Agent => 'Cryptozilla/5.0b1',
  746.                  Referer    => 'https://www.bacus.pt'
  747.         ));
  748.  
  749.   ($page, $result, %headers) =                                   # 2b
  750.          = get_https('www.bacus.pt', 443, '/protected.html',
  751.           make_headers(Authorization =>
  752.                'Basic ' . MIME::Base64::encode("$user:$pass",''))
  753.           );
  754.  
  755.   ($page, $response, %reply_headers)
  756.      = post_https('www.bacus.pt', 443, '/foo.cgi', '',       # 3
  757.         make_form(OK   => '1',
  758.               name => 'Sampo'
  759.         ));
  760.  
  761.   $reply = sslcat($host, $port, $request);                       # 4
  762.  
  763.   ($reply, $err, $server_cert) = sslcat($host, $port, $request); # 5
  764.  
  765.   $Net::SSLeay::trace = 2;  # 0=no debugging, 1=ciphers, 2=trace, 3=dump data
  766.  
  767. =head1 DESCRIPTION
  768.  
  769. There is a related module called C<Net::SSLeay::Handle> included in this
  770. distribution that you might want to use instead. It has its own pod
  771. documentation.
  772.  
  773. This module offers some high level convenience functions for accessing
  774. web pages on SSL servers (for symmetry, the same API is offered for
  775. accessing http servers, too), an C<sslcat()> function for writing your own
  776. clients, and finally access to the SSL api of the SSLeay/OpenSSL package
  777. so you can write servers or clients for more complicated applications.
  778.  
  779. For high level functions it is most convenient to import them into your
  780. main namespace as indicated in the synopsis.
  781.  
  782. Case 1 demonstrates the typical invocation of get_https() to fetch an HTML
  783. page from secure server. The first argument provides the hostname or IP
  784. in dotted decimal notation of the remote server to contact. The second
  785. argument is the TCP port at the remote end (your own port is picked
  786. arbitrarily from high numbered ports as usual for TCP). The third
  787. argument is the URL of the page without the host name part. If in
  788. doubt consult the HTTP specifications at L<http://www.w3c.org>.
  789.  
  790. Case 2 demonstrates full fledged use of C<get_https()>. As can be seen,
  791. C<get_https()> parses the response and response headers and returns them as
  792. a list, which can be captured in a hash for later reference. Also a
  793. fourth argument to C<get_https()> is used to insert some additional headers
  794. in the request. C<make_headers()> is a function that will convert a list or
  795. hash to such headers. By default C<get_https()> supplies C<Host> (to make
  796. virtual hosting easy) and C<Accept> (reportedly needed by IIS) headers.
  797.  
  798. Case 2b demonstrates how to get a password protected page. Refer to
  799. the HTTP protocol specifications for further details (e.g. RFC-2617).
  800.  
  801. Case 3 invokes C<post_https()> to submit a HTML/CGI form to a secure
  802. server. The first four arguments are equal to C<get_https()> (note that 
  803. the empty string (C<''>) is passed as header argument).
  804. The fifth argument is the
  805. contents of the form formatted according to CGI specification. In this
  806. case the helper function C<make_https()> is used to do the formatting,
  807. but you could pass any string. C<post_https()> automatically adds
  808. C<Content-Type> and C<Content-Length> headers to the request.
  809.  
  810. Case 4 shows the fundamental C<sslcat()> function (inspired in spirit by
  811. the C<netcat> utility :-). It's your swiss army knife that allows you to
  812. easily contact servers, send some data, and then get the response. You
  813. are responsible for formatting the data and parsing the response -
  814. C<sslcat()> is just a transport.
  815.  
  816. Case 5 is a full invocation of C<sslcat()> which allows the return of errors
  817. as well as the server (peer) certificate.
  818.  
  819. The C<$trace> global variable can be used to control the verbosity of the 
  820. high level functions. Level 0 guarantees silence, level 1 (the default)
  821. only emits error messages.
  822.  
  823. =head2 Alternate versions of the API
  824.  
  825. The above mentioned functions actually return the response headers as
  826. a list, which only gets converted to hash upon assignment (this
  827. assignment looses information if the same header occurs twice, as may
  828. be the case with cookies). There are also other variants of the
  829. functions that return unprocessed headers and that return a reference
  830. to a hash.
  831.  
  832.   ($page, $response, @headers) = get_https('www.bacus.pt', 443, '/');
  833.   for ($i = 0; $i < $#headers; $i+=2) {
  834.       print "$headers[$i] = " . $headers[$i+1] . "\n";
  835.   }
  836.  
  837.   ($page, $response, $headers, $server_cert)
  838.     = get_https3('www.bacus.pt', 443, '/');
  839.   print "$headers\n";
  840.  
  841.   ($page, $response, %headers_ref, $server_cert)
  842.     = get_https4('www.bacus.pt', 443, '/');
  843.   for $k (sort keys %{headers_ref}) {
  844.       for $v (@{$headers_ref{$k}}) {
  845.       print "$k = $v\n";
  846.       }
  847.   }
  848.  
  849. All of the above code fragments accomplish the same thing: display all
  850. values of all headers. The API functions ending in "3" return the
  851. headers simply as a scalar string and it is up to the application to
  852. split them up. The functions ending in "4" return a reference to
  853. a hash of arrays (see L<perlref> and L<perllol> if you are
  854. not familiar with complex perl data structures). To access a single value
  855. of such a header hash you would do something like
  856.  
  857.   print $headers_ref{COOKIE}[0];
  858.  
  859. Variants 3 and 4 also allow you to discover the server certificate
  860. in case you would like to store or display it, e.g.
  861.  
  862.   ($p, $resp, $hdrs, $server_cert) = get_https3('www.bacus.pt', 443, '/');
  863.   if (!defined($server_cert) || ($server_cert == 0)) {
  864.       warn "Subject Name: undefined, Issuer  Name: undefined";
  865.   } else {
  866.       warn 'Subject Name: '
  867.       . Net::SSLeay::X509_NAME_oneline(
  868.          Net::SSLeay::X509_get_subject_name($server_cert))
  869.           . 'Issuer  Name: '
  870.           . Net::SSLeay::X509_NAME_oneline(
  871.                          Net::SSLeay::X509_get_issuer_name($server_cert));
  872.   }
  873.  
  874. Beware that this method only allows after the fact verification of
  875. the certificate: by the time C<get_https3()> has returned the https
  876. request has already been sent to the server, whether you decide to
  877. trust it or not. To do the verification correctly you must either
  878. employ the OpenSSL certificate verification framework or use
  879. the lower level API to first connect and verify the certificate
  880. and only then send the http data. See the implementation of C<ds_https3()>
  881. for guidance on how to do this.
  882.  
  883. =head2 Using client certificates
  884.  
  885. Secure web communications are encrypted using symmetric crypto keys
  886. exchanged using encryption based on the certificate of the
  887. server. Therefore in all SSL connections the server must have a
  888. certificate. This serves both to authenticate the server to the
  889. clients and to perform the key exchange.
  890.  
  891. Sometimes it is necessary to authenticate the client as well. Two
  892. options are available: HTTP basic authentication and a client side
  893. certificate. The basic authentication over HTTPS is actually quite
  894. safe because HTTPS guarantees that the password will not travel in
  895. the clear. Never-the-less, problems like easily guessable passwords
  896. remain. The client certificate method involves authentication of the
  897. client at the SSL level using a certificate. For this to work, both the
  898. client and the server have certificates (which typically are
  899. different) and private keys.
  900.  
  901. The API functions outlined above accept additional arguments that
  902. allow one to supply the client side certificate and key files. The
  903. format of these files is the same as used for server certificates and
  904. the caveat about encrypting private keys applies.
  905.  
  906.   ($page, $result, %headers) =                                   # 2c
  907.          = get_https('www.bacus.pt', 443, '/protected.html',
  908.           make_headers(Authorization =>
  909.                'Basic ' . MIME::Base64::encode("$user:$pass",'')),
  910.           '', $mime_type6, $path_to_crt7, $path_to_key8);
  911.  
  912.   ($page, $response, %reply_headers)
  913.      = post_https('www.bacus.pt', 443, '/foo.cgi',           # 3b
  914.           make_headers('Authorization' =>
  915.                'Basic ' . MIME::Base64::encode("$user:$pass",'')),
  916.           make_form(OK   => '1', name => 'Sampo'),
  917.           $mime_type6, $path_to_crt7, $path_to_key8);
  918.  
  919. Case 2c demonstrates getting a password protected page that also requires
  920. a client certificate, i.e. it is possible to use both authentication
  921. methods simultaneously.
  922.  
  923. Case 3b is a full blown POST to a secure server that requires both password
  924. authentication and a client certificate, just like in case 2c.
  925.  
  926. Note: The client will not send a certificate unless the server requests one.
  927. This is typically achieved by setting the verify mode to C<VERIFY_PEER> on the
  928. server:
  929.  
  930.   Net::SSLeay::set_verify(ssl, Net::SSLeay::VERIFY_PEER, 0);
  931.  
  932. See C<perldoc ~openssl/doc/ssl/SSL_CTX_set_verify.pod> for a full description.
  933.  
  934. =head2 Working through a web proxy
  935.  
  936. C<Net::SSLeay> can use a web proxy to make its connections. You need to
  937. first set the proxy host and port using C<set_proxy()> and then just
  938. use the normal API functions, e.g:
  939.  
  940.   Net::SSLeay::set_proxy('gateway.myorg.com', 8080);
  941.   ($page) = get_https('www.bacus.pt', 443, '/');
  942.  
  943. If your proxy requires authentication, you can supply a username and
  944. password as well
  945.  
  946.   Net::SSLeay::set_proxy('gateway.myorg.com', 8080, 'joe', 'salainen');
  947.   ($page, $result, %headers) =
  948.          = get_https('www.bacus.pt', 443, '/protected.html',
  949.           make_headers(Authorization =>
  950.                'Basic ' . MIME::Base64::encode("susie:pass",''))
  951.           );
  952.  
  953. This example demonstrates the case where we authenticate to the proxy as
  954. C<"joe"> and to the final web server as C<"susie">. Proxy authentication
  955. requires the C<MIME::Base64> module to work.
  956.  
  957. =head2 Certificate verification and Certificate Revoocation Lists (CRLs)
  958.  
  959. OpenSSL supports the ability to verify peer certificates. It can also
  960. optionally check the peer certificate against a Certificate Revocation
  961. List (CRL) from the certificates issuer. A CRL is a file, created by
  962. the certificate issuer that lists all the certificates that it
  963. previously signed, but which it now revokes. CRLs are in PEM format.
  964.  
  965. You can enable C<Net::SSLeay CRL> checking like this:
  966.  
  967.         &Net::SSLeay::X509_STORE_CTX_set_flags
  968.         (&Net::SSLeay::CTX_get_cert_store($ssl), 
  969.          &Net::SSLeay::X509_V_FLAG_CRL_CHECK); 
  970.  
  971. After setting this flag, if OpenSSL checks a peer's certificate, then
  972. it will attempt to find a CRL for the issuer. It does this by looking
  973. for a specially named file in the search directory specified by
  974. CTX_load_verify_locations.  CRL files are named with the hash of the
  975. issuer's subject name, followed by C<.r0>, C<.r1> etc.  For example
  976. C<ab1331b2.r0>, C<ab1331b2.r1>. It will read all the .r files for the
  977. issuer, and then check for a revocation of the peer cerificate in all
  978. of them.  (You can also force it to look in a specific named CRL
  979. file., see below).  You can find out the hash of the issuer subject
  980. name in a CRL with
  981.  
  982.     openssl crl -in crl.pem -hash -noout
  983.  
  984. If the peer certificate does not pass the revocation list, or if no
  985. CRL is found, then the handshaking fails with an error.
  986.  
  987. You can also force OpenSSL to look for CRLs in one or more arbitrarily
  988. named files.
  989.  
  990.     my $bio = Net::SSLeay::BIO_new_file($crlfilename, 'r');
  991.     my $crl = Net::SSLeay::PEM_read_bio_X509_CRL($bio);
  992.     if ($crl) {
  993.         Net::SSLeay::X509_STORE_add_crl(
  994.             Net::SSLeay::CTX_get_cert_store($ssl, $crl);
  995.     } else {
  996.         error reading CRL....
  997.     }
  998.  
  999.  
  1000. =head2 Convenience routines
  1001.  
  1002. To be used with Low level API
  1003.  
  1004.     Net::SSLeay::randomize($rn_seed_file,$additional_seed);
  1005.     Net::SSLeay::set_cert_and_key($ctx, $cert_path, $key_path);
  1006.     $cert = Net::SSLeay::dump_peer_certificate($ssl);
  1007.     Net::SSLeay::ssl_write_all($ssl, $message) or die "ssl write failure";
  1008.     $got = Net::SSLeay::ssl_read_all($ssl) or die "ssl read failure";
  1009.  
  1010.     $got = Net::SSLeay::ssl_read_CRLF($ssl [, $max_length]);
  1011.     $got = Net::SSLeay::ssl_read_until($ssl [, $delimit [, $max_length]]);
  1012.     Net::SSLeay::ssl_write_CRLF($ssl, $message);
  1013.  
  1014. C<randomize()> seeds the openssl PRNG with C</dev/urandom> (see the top of C<SSLeay.pm>
  1015. for how to change or configure this) and optionally with user provided
  1016. data. It is very important to properly seed your random numbers, so
  1017. do not forget to call this. The high level API functions automatically
  1018. call C<randomize()> so it is not needed with them. See also caveats.
  1019.  
  1020. C<set_cert_and_key()> takes two file names as arguments and sets
  1021. the certificate and private key to those. This can be used to
  1022. set either cerver certificates or client certificates.
  1023.  
  1024. C<dump_peer_certificate()> allows you to get a plaintext description of the
  1025. certificate the peer (usually the server) presented to us.
  1026.  
  1027. C<ssl_read_all()> and C<ssl_write_all()> provide true blocking semantics for
  1028. these operations (see limitation, below, for explanation). These are
  1029. much preferred to the low level API equivalents (which implement BSD
  1030. blocking semantics). The message argument to C<ssl_write_all()> can be
  1031. a reference. This is helpful to avoid unnecessary copying when writing
  1032. something big, e.g:
  1033.  
  1034.     $data = 'A' x 1000000000;
  1035.     Net::SSLeay::ssl_write_all($ssl, \$data) or die "ssl write failed";
  1036.  
  1037. C<ssl_read_CRLF()> uses C<ssl_read_all()> to read in a line terminated with a
  1038. carriage return followed by a linefeed (CRLF).  The CRLF is included in
  1039. the returned scalar.
  1040.  
  1041. C<ssl_read_until()> uses C<ssl_read_all()> to read from the SSL input
  1042. stream until it encounters a programmer specified delimiter.
  1043. If the delimiter is undefined, C<$/> is used.  If C<$/> is undefined,
  1044. C<\n> is used.  One can optionally set a maximum length of bytes to read
  1045. from the SSL input stream.
  1046.  
  1047. C<ssl_write_CRLF()> writes C<$message> and appends CRLF to the SSL output stream.
  1048.  
  1049. =head2 Low level API
  1050.  
  1051. In addition to the high level functions outlined above, this module
  1052. contains straight-forward access to SSL part of OpenSSL C api. Only the SSL
  1053. subpart of OpenSSL is implemented (if anyone wants to implement other
  1054. parts, feel free to submit patches).
  1055.  
  1056. See the C<ssl.h> header from OpenSSL C distribution for a list of low level
  1057. SSLeay functions to call (check SSLeay.xs to see if some function has been
  1058. implemented). The module strips the initial C<"SSL_"> off of the SSLeay names. Generally you should use C<Net::SSLeay::> in its
  1059. place. For example:
  1060.  
  1061. In C:
  1062.  
  1063.     #include <ssl.h>
  1064.  
  1065.     err = SSL_set_verify (ssl, SSL_VERIFY_CLIENT_ONCE,
  1066.                    &your_call_back_here);
  1067.  
  1068. In Perl:
  1069.  
  1070.     use Net::SSLeay;
  1071.  
  1072.     $err = Net::SSLeay::set_verify ($ssl,
  1073.                     Net::SSLeay::VERIFY_CLIENT_ONCE,
  1074.                     \&your_call_back_here);
  1075.  
  1076. If the function does not start with C<SSL_> you should use the full
  1077. function name, e.g.:
  1078.  
  1079.     $err = Net::SSLeay::ERR_get_error;
  1080.  
  1081. The following new functions behave in perlish way:
  1082.  
  1083.     $got = Net::SSLeay::read($ssl);
  1084.                                     # Performs SSL_read, but returns $got
  1085.                                     # resized according to data received.
  1086.                                     # Returns undef on failure.
  1087.  
  1088.     Net::SSLeay::write($ssl, $foo) || die;
  1089.                                     # Performs SSL_write, but automatically
  1090.                                     # figures out the size of $foo
  1091.  
  1092. In order to use the low level API you should start your programs with
  1093. the following incantation:
  1094.  
  1095.     use Net::SSLeay qw(die_now die_if_ssl_error);
  1096.     Net::SSLeay::load_error_strings();
  1097.     Net::SSLeay::SSLeay_add_ssl_algorithms();    # Important!
  1098.         Net::SSLeay::ENGINE_load_builtin_engines();  # If you want built-in engines
  1099.         Net::SSLeay::ENGINE_register_all_complete(); # If you want built-in engines
  1100.         Net::SSLeay::randomize();
  1101.  
  1102. C<die_now()> and C<die_if_ssl_error()> are used to conveniently print the SSLeay error stack when something goes wrong, thusly:
  1103.  
  1104.     Net::SSLeay::connect($ssl) or die_now("Failed SSL connect ($!)");
  1105.     Net::SSLeay::write($ssl, "foo") or die_if_ssl_error("SSL write ($!)");
  1106.  
  1107. You can also use C<Net::SSLeay::print_errs()> to dump the error stack without
  1108. exiting the program. As can be seen, your code becomes much more readable
  1109. if you import the error reporting functions into your main name space.
  1110.  
  1111. I can not emphasize the need to check for error enough. Use these
  1112. functions even in the most simple programs, they will reduce debugging
  1113. time greatly. Do not ask questions on the mailing list without having
  1114. first sprinkled these in your code.
  1115.  
  1116. =head2 Sockets
  1117.  
  1118. Perl uses file handles for all I/O. While SSLeay has a quite flexible BIO
  1119. mechanism and perl has an evolved PerlIO mechanism, this module still
  1120. sticks to using file descriptors. Thus to attach SSLeay to a socket you
  1121. should use C<fileno()> to extract the underlying file descriptor:
  1122.  
  1123.     Net::SSLeay::set_fd($ssl, fileno(S));   # Must use fileno
  1124.  
  1125. You should also set C<$|> to 1 to eliminate STDIO buffering so you do not
  1126. get confused if you use perl I/O functions to manipulate your socket
  1127. handle.
  1128.  
  1129. If you need to C<select(2)> on the socket, go right ahead, but be warned
  1130. that OpenSSL does some internal buffering so SSL_read does not always
  1131. return data even if the socket selected for reading (just keep on
  1132. selecting and trying to read). C<Net::SSLeay> is no different from the
  1133. C language OpenSSL in this respect.
  1134.  
  1135. =head2 Callbacks
  1136.  
  1137. You can establish a per-context verify callback function something like this:
  1138.  
  1139.     sub verify {
  1140.         my ($ok, $x509_store_ctx) = @_;
  1141.         print "Verifying certificate...\n";
  1142.         ...
  1143.         return $ok;
  1144.     }
  1145.  
  1146. It is used like this:
  1147.  
  1148.     Net::SSLeay::set_verify ($ssl, Net::SSLeay::VERIFY_PEER, \&verify);
  1149.  
  1150. Per-context callbacks for decrypting private keys are implemented.
  1151.  
  1152.         Net::SSLeay::CTX_set_default_passwd_cb($ctx, sub { "top-secret" });
  1153.         Net::SSLeay::CTX_use_PrivateKey_file($ctx, "key.pem",
  1154.                          Net::SSLeay::FILETYPE_PEM)
  1155.             or die "Error reading private key";
  1156.         Net::SSLeay::CTX_set_default_passwd_cb($ctx, undef);
  1157.  
  1158. If Hello Extensions are supported by your OpenSSL, 
  1159. a session secret callback can be set up to be called when a session secret is set
  1160. by openssl.
  1161.  
  1162. Establish it like this:
  1163.     Net::SSLeay::set_session_secret_cb($ssl, \&session_secret_cb, $somedata);
  1164.  
  1165. It will be called like this:
  1166.  
  1167.     sub session_secret_cb
  1168.     {
  1169.         my ($secret, \@cipherlist, \$preferredcipher, $somedata) = @_;
  1170.     }
  1171.  
  1172.  
  1173. No other callbacks are implemented. You do not need to use any
  1174. callback for simple (i.e. normal) cases where the SSLeay built-in
  1175. verify mechanism satisfies your needs.
  1176.  
  1177. It is required to reset these callbacks to undef immediately after use to prevent 
  1178. memory leaks, thread safety problems and crashes on exit that 
  1179. can occur if different threads set different callbacks. 
  1180.  
  1181. If you want to use callback stuff, see examples/callback.pl! Its the
  1182. only one I am able to make work reliably.
  1183.  
  1184. =head2 X509 and RAND stuff
  1185.  
  1186. This module largely lacks interface to the X509 and RAND routines, but
  1187. as I was lazy and needed them, the following kludges are implemented:
  1188.  
  1189.     $x509_name = Net::SSLeay::X509_get_subject_name($x509_cert);
  1190.     $x509_name = Net::SSLeay::X509_get_issuer_name($x509_cert);
  1191.     print Net::SSLeay::X509_NAME_oneline($x509_name);
  1192.     $text = Net::SSLeay::X509_NAME_get_text_by_NID($name, $nid);
  1193.  
  1194.     ($type1, $subject1, $type2, $subject2, ...) =
  1195.        Net::SSLeay::X509_get_subjectAltNames($x509_cert)
  1196.  
  1197.     subjectAltName types as per x509v3.h GEN_*, for example
  1198.     GEN_DNS or GEN_IPADD which can be imported.
  1199.  
  1200.     Net::SSLeay::RAND_seed($buf);   # Perlishly figures out buf size
  1201.     Net::SSLeay::RAND_bytes($buf, $num);
  1202.     Net::SSLeay::RAND_pseudo_bytes($buf, $num);
  1203.     Net::SSLeay::RAND_add($buf, $num, $entropy);
  1204.     Net::SSLeay::RAND_poll();
  1205.     Net::SSLeay::RAND_status();
  1206.     Net::SSLeay::RAND_cleanup();
  1207.     Net::SSLeay::RAND_file_name($num);
  1208.     Net::SSLeay::RAND_load_file($file_name, $how_many_bytes);
  1209.     Net::SSLeay::RAND_write_file($file_name);
  1210.     Net::SSLeay::RAND_egd($path);
  1211.     Net::SSLeay::RAND_egd_bytes($path, $bytes);
  1212.  
  1213. Actually you should consider using the following helper functions:
  1214.  
  1215.     print Net::SSLeay::dump_peer_certificate($ssl);
  1216.     Net::SSLeay::randomize();
  1217.  
  1218. =head2 RSA interface
  1219.  
  1220. Some RSA functions are available:
  1221.  
  1222.     $rsakey = Net::SSLeay::RSA_generate_key();
  1223.     Net::SSLeay::CTX_set_tmp_rsa($ctx, $rsakey);
  1224.     Net::SSLeay::RSA_free($rsakey);
  1225.  
  1226. =head2 Digests
  1227.  
  1228. Some Digest functions are available if supported by the underlying
  1229. library.  These may include MD2, MD4, MD5, and RIPEMD160:
  1230.  
  1231.     $hash = Net::SSLeay::MD5($foo);
  1232.     print unpack('H*', $hash);
  1233.  
  1234. =head2 BIO interface
  1235.  
  1236. Some BIO functions are available:
  1237.  
  1238.     Net::SSLeay::BIO_s_mem();
  1239.     $bio = Net::SSLeay::BIO_new(BIO_s_mem())
  1240.     $bio = Net::SSLeay::BIO_new_file($filename, $mode);
  1241.     Net::SSLeay::BIO_free($bio)
  1242.     $count = Net::SSLeay::BIO_write($data);
  1243.     $data = Net::SSLeay::BIO_read($bio);
  1244.     $data = Net::SSLeay::BIO_read($bio, $maxbytes);
  1245.     $is_eof = Net::SSLeay::BIO_eof($bio);
  1246.     $count = Net::SSLeay::BIO_pending($bio);
  1247.     $count = Net::SSLeay::BIO_wpending ($bio);
  1248.  
  1249. =head2 Low level API
  1250.  
  1251. Some very low level API functions are available:
  1252.  
  1253.     $client_random = Net::SSLeay::get_client_random($ssl);
  1254.     $server_random = Net::SSLeay::get_server_random($ssl);
  1255.     $session = Net::SSLeay::get_session($ssl);
  1256.     $master_key = Net::SSLeay::SESSION_get_master_key($session);
  1257.     Net::SSLeay::SESSION_set_master_key($session, $master_secret);
  1258.     $keyblocksize = Net::SSLeay::get_keyblock_size($session);
  1259.  
  1260. =head2 HTTP (without S) API
  1261.  
  1262. Over the years it has become clear that it would be convenient to use
  1263. the light-weight flavour API of C<Net::SSLeay> for normal HTTP as well (see
  1264. C<LWP> for the heavy-weight object-oriented approach). In fact it would be
  1265. nice to be able to flip https on and off on the fly. Thus regular HTTP
  1266. support was evolved.
  1267.  
  1268.   use Net::SSLeay qw(get_http post_http tcpcat
  1269.                       get_httpx post_httpx tcpxcat
  1270.                       make_headers make_form);
  1271.  
  1272.   ($page, $result, %headers) =
  1273.          = get_http('www.bacus.pt', 443, '/protected.html',
  1274.           make_headers(Authorization =>
  1275.                'Basic ' . MIME::Base64::encode("$user:$pass",''))
  1276.           );
  1277.  
  1278.   ($page, $response, %reply_headers)
  1279.      = post_http('www.bacus.pt', 443, '/foo.cgi', '',
  1280.         make_form(OK   => '1',
  1281.               name => 'Sampo'
  1282.         ));
  1283.  
  1284.   ($reply, $err) = tcpcat($host, $port, $request);
  1285.  
  1286.   ($page, $result, %headers) =
  1287.          = get_httpx($usessl, 'www.bacus.pt', 443, '/protected.html',
  1288.           make_headers(Authorization =>
  1289.                'Basic ' . MIME::Base64::encode("$user:$pass",''))
  1290.           );
  1291.  
  1292.   ($page, $response, %reply_headers)
  1293.      = post_httpx($usessl, 'www.bacus.pt', 443, '/foo.cgi', '',
  1294.         make_form(OK   => '1',  name => 'Sampo'    ));
  1295.  
  1296.   ($reply, $err, $server_cert) = tcpxcat($usessl, $host, $port, $request);
  1297.  
  1298. As can be seen, the C<"x"> family of APIs takes as the first argument a flag
  1299. which indicates whether SSL is used or not.
  1300.  
  1301. =head1 EXAMPLES
  1302.  
  1303. One very good example to look at is the implementation of C<sslcat()> in the
  1304. C<SSLeay.pm> file.
  1305.  
  1306. The following is a simple SSLeay client (with too little error checking :-(
  1307.  
  1308.     #!/usr/local/bin/perl
  1309.     use Socket;
  1310.     use Net::SSLeay qw(die_now die_if_ssl_error) ;
  1311.     Net::SSLeay::load_error_strings();
  1312.     Net::SSLeay::SSLeay_add_ssl_algorithms();
  1313.     Net::SSLeay::randomize();
  1314.  
  1315.     ($dest_serv, $port, $msg) = @ARGV;      # Read command line
  1316.     $port = getservbyname ($port, 'tcp') unless $port =~ /^\d+$/;
  1317.     $dest_ip = gethostbyname ($dest_serv);
  1318.     $dest_serv_params  = sockaddr_in($port, $dest_ip);
  1319.  
  1320.     socket  (S, &AF_INET, &SOCK_STREAM, 0)  or die "socket: $!";
  1321.     connect (S, $dest_serv_params)          or die "connect: $!";
  1322.     select  (S); $| = 1; select (STDOUT);   # Eliminate STDIO buffering
  1323.  
  1324.     # The network connection is now open, lets fire up SSL    
  1325.  
  1326.     $ctx = Net::SSLeay::CTX_new() or die_now("Failed to create SSL_CTX $!");
  1327.     Net::SSLeay::CTX_set_options($ctx, &Net::SSLeay::OP_ALL)
  1328.          and die_if_ssl_error("ssl ctx set options");
  1329.     $ssl = Net::SSLeay::new($ctx) or die_now("Failed to create SSL $!");
  1330.     Net::SSLeay::set_fd($ssl, fileno(S));   # Must use fileno
  1331.     $res = Net::SSLeay::connect($ssl) and die_if_ssl_error("ssl connect");
  1332.     print "Cipher `" . Net::SSLeay::get_cipher($ssl) . "'\n";
  1333.  
  1334.     # Exchange data
  1335.  
  1336.     $res = Net::SSLeay::write($ssl, $msg);  # Perl knows how long $msg is
  1337.     die_if_ssl_error("ssl write");
  1338.     CORE::shutdown S, 1;  # Half close --> No more output, sends EOF to server
  1339.     $got = Net::SSLeay::read($ssl);         # Perl returns undef on failure
  1340.     die_if_ssl_error("ssl read");
  1341.     print $got;
  1342.  
  1343.     Net::SSLeay::free ($ssl);               # Tear down connection
  1344.     Net::SSLeay::CTX_free ($ctx);
  1345.     close S;
  1346.  
  1347. The following is a simple SSLeay echo server (non forking):
  1348.  
  1349.     #!/usr/local/bin/perl -w
  1350.     use Socket;
  1351.     use Net::SSLeay qw(die_now die_if_ssl_error);
  1352.     Net::SSLeay::load_error_strings();
  1353.     Net::SSLeay::SSLeay_add_ssl_algorithms();
  1354.     Net::SSLeay::randomize();
  1355.  
  1356.     $our_ip = "\0\0\0\0"; # Bind to all interfaces
  1357.     $port = 1235;                             
  1358.     $sockaddr_template = 'S n a4 x8';
  1359.     $our_serv_params = pack ($sockaddr_template, &AF_INET, $port, $our_ip);
  1360.  
  1361.     socket (S, &AF_INET, &SOCK_STREAM, 0)  or die "socket: $!";
  1362.     bind (S, $our_serv_params)             or die "bind:   $!";
  1363.     listen (S, 5)                          or die "listen: $!";
  1364.     $ctx = Net::SSLeay::CTX_new ()         or die_now("CTX_new ($ctx): $!");
  1365.     Net::SSLeay::CTX_set_options($ctx, &Net::SSLeay::OP_ALL)
  1366.          and die_if_ssl_error("ssl ctx set options");
  1367.  
  1368.     # Following will ask password unless private key is not encrypted
  1369.     Net::SSLeay::CTX_use_RSAPrivateKey_file ($ctx, 'plain-rsa.pem',
  1370.                                              &Net::SSLeay::FILETYPE_PEM);
  1371.     die_if_ssl_error("private key");
  1372.     Net::SSLeay::CTX_use_certificate_file ($ctx, 'plain-cert.pem',
  1373.                             &Net::SSLeay::FILETYPE_PEM);
  1374.     die_if_ssl_error("certificate");
  1375.  
  1376.     while (1) {    
  1377.         print "Accepting connections...\n";
  1378.         ($addr = accept (NS, S))           or die "accept: $!";
  1379.         select (NS); $| = 1; select (STDOUT);  # Piping hot!
  1380.  
  1381.         ($af,$client_port,$client_ip) = unpack($sockaddr_template,$addr);
  1382.         @inetaddr = unpack('C4',$client_ip);
  1383.         print "$af connection from " .
  1384.         join ('.', @inetaddr) . ":$client_port\n";
  1385.  
  1386.         # We now have a network connection, lets fire up SSLeay...
  1387.  
  1388.         $ssl = Net::SSLeay::new($ctx)      or die_now("SSL_new ($ssl): $!");
  1389.         Net::SSLeay::set_fd($ssl, fileno(NS));
  1390.  
  1391.         $err = Net::SSLeay::accept($ssl) and die_if_ssl_error('ssl accept');
  1392.         print "Cipher `" . Net::SSLeay::get_cipher($ssl) . "'\n";
  1393.  
  1394.         # Connected. Exchange some data.
  1395.  
  1396.         $got = Net::SSLeay::read($ssl);     # Returns undef on fail
  1397.         die_if_ssl_error("ssl read");
  1398.         print "Got `$got' (" . length ($got) . " chars)\n";
  1399.  
  1400.         Net::SSLeay::write ($ssl, uc ($got)) or die "write: $!";
  1401.         die_if_ssl_error("ssl write");
  1402.  
  1403.         Net::SSLeay::free ($ssl);           # Tear down connection
  1404.         close NS;
  1405.     }
  1406.  
  1407. Yet another echo server. This one runs from C</etc/inetd.conf> so it avoids
  1408. all the socket code overhead. Only caveat is opening an rsa key file -
  1409. it had better be without any encryption or else it will not know where
  1410. to ask for the password. Note how C<STDIN> and C<STDOUT> are wired to SSL.
  1411.  
  1412.     #!/usr/local/bin/perl
  1413.     # /etc/inetd.conf
  1414.     #    ssltst stream tcp nowait root /path/to/server.pl server.pl
  1415.     # /etc/services
  1416.     #    ssltst        1234/tcp
  1417.  
  1418.     use Net::SSLeay qw(die_now die_if_ssl_error);
  1419.     Net::SSLeay::load_error_strings();
  1420.     Net::SSLeay::SSLeay_add_ssl_algorithms();
  1421.     Net::SSLeay::randomize();
  1422.  
  1423.     chdir '/key/dir' or die "chdir: $!";
  1424.     $| = 1;  # Piping hot!
  1425.     open LOG, ">>/dev/console" or die "Can't open log file $!";
  1426.     select LOG; print "server.pl started\n";
  1427.  
  1428.     $ctx = Net::SSLeay::CTX_new()     or die_now "CTX_new ($ctx) ($!)";
  1429.     $ssl = Net::SSLeay::new($ctx)     or die_now "new ($ssl) ($!)";
  1430.     Net::SSLeay::set_options($ssl, &Net::SSLeay::OP_ALL)
  1431.          and die_if_ssl_error("ssl set options");
  1432.  
  1433.     # We get already open network connection from inetd, now we just
  1434.     # need to attach SSLeay to STDIN and STDOUT
  1435.     Net::SSLeay::set_rfd($ssl, fileno(STDIN));
  1436.     Net::SSLeay::set_wfd($ssl, fileno(STDOUT));
  1437.  
  1438.     Net::SSLeay::use_RSAPrivateKey_file ($ssl, 'plain-rsa.pem',
  1439.                                          Net::SSLeay::FILETYPE_PEM);
  1440.     die_if_ssl_error("private key");
  1441.     Net::SSLeay::use_certificate_file ($ssl, 'plain-cert.pem',
  1442.                                        Net::SSLeay::FILETYPE_PEM);
  1443.     die_if_ssl_error("certificate");
  1444.  
  1445.     Net::SSLeay::accept($ssl) and die_if_ssl_err("ssl accept: $!");
  1446.     print "Cipher `" . Net::SSLeay::get_cipher($ssl) . "'\n";
  1447.  
  1448.     $got = Net::SSLeay::read($ssl);
  1449.     die_if_ssl_error("ssl read");
  1450.     print "Got `$got' (" . length ($got) . " chars)\n";
  1451.  
  1452.     Net::SSLeay::write ($ssl, uc($got)) or die "write: $!";
  1453.     die_if_ssl_error("ssl write");
  1454.  
  1455.     Net::SSLeay::free ($ssl);         # Tear down the connection
  1456.     Net::SSLeay::CTX_free ($ctx);
  1457.     close LOG;
  1458.  
  1459. There are also a number of example/test programs in the examples directory:
  1460.  
  1461.     sslecho.pl   -  A simple server, not unlike the one above
  1462.     minicli.pl   -  Implements a client using low level SSLeay routines
  1463.     sslcat.pl    -  Demonstrates using high level sslcat utility function
  1464.     get_page.pl  -  Is a utility for getting html pages from secure servers
  1465.     callback.pl  -  Demonstrates certificate verification and callback usage
  1466.     stdio_bulk.pl       - Does SSL over Unix pipes
  1467.     ssl-inetd-serv.pl   - SSL server that can be invoked from inetd.conf
  1468.     httpd-proxy-snif.pl - Utility that allows you to see how a browser
  1469.                           sends https request to given server and what reply
  1470.                           it gets back (very educative :-)
  1471.     makecert.pl  -  Creates a self signed cert (does not use this module)
  1472.  
  1473. =head1 LIMITATIONS
  1474.  
  1475. C<Net::SSLeay::read()> uses an internal buffer of 32KB, thus no single read
  1476. will return more. In practice one read returns much less, usually
  1477. as much as fits in one network packet. To work around this,
  1478. you should use a loop like this:
  1479.  
  1480.     $reply = '';
  1481.     while ($got = Net::SSLeay::read($ssl)) {
  1482.         last if print_errs('SSL_read');
  1483.         $reply .= $got;
  1484.     }
  1485.  
  1486. Although there is no built-in limit in C<Net::SSLeay::write()>, the network
  1487. packet size limitation applies here as well, thus use:
  1488.  
  1489.     $written = 0;
  1490.  
  1491.     while ($written < length($message)) {
  1492.         $written += Net::SSLeay::write($ssl, substr($message, $written));
  1493.         last if print_errs('SSL_write');
  1494.     }
  1495.  
  1496. Or alternatively you can just use the following convenience functions:
  1497.  
  1498.     Net::SSLeay::ssl_write_all($ssl, $message) or die "ssl write failure";
  1499.     $got = Net::SSLeay::ssl_read_all($ssl) or die "ssl read failure";
  1500.  
  1501. =head1 KNOWN BUGS AND CAVEATS
  1502.  
  1503. Autoloader emits a
  1504.  
  1505.     Argument "xxx" isn't numeric in entersub at blib/lib/Net/SSLeay.pm'
  1506.  
  1507. warning if die_if_ssl_error is made autoloadable. If you figure out why,
  1508. drop me a line.
  1509.  
  1510. Callback set using C<SSL_set_verify()> does not appear to work. This may
  1511. well be an openssl problem (e.g. see C<ssl/ssl_lib.c> line 1029). Try using
  1512. C<SSL_CTX_set_verify()> instead and do not be surprised if even this stops
  1513. working in future versions.
  1514.  
  1515. Callback and certificate verification stuff is generally too little tested.
  1516.  
  1517. Random numbers are not initialized randomly enough, especially if you
  1518. do not have C</dev/random> and/or C</dev/urandom> (such as in Solaris
  1519. platforms - but I've been suggested that cryptorand daemon from the SUNski
  1520. package solves this). In this case you should investigate third party
  1521. software that can emulate these devices, e.g. by way of a named pipe
  1522. to some program.
  1523.  
  1524. Another gotcha with random number initialization is randomness
  1525. depletion. This phenomenon, which has been extensively discussed in
  1526. OpenSSL, Apache-SSL, and Apache-mod_ssl forums, can cause your
  1527. script to block if you use C</dev/random> or to operate insecurely
  1528. if you use C</dev/urandom>. What happens is that when too much
  1529. randomness is drawn from the operating system's randomness pool
  1530. then randomness can temporarily be unavailable. C</dev/random> solves
  1531. this problem by waiting until enough randomness can be gathered - and
  1532. this can take a long time since blocking reduces activity in the
  1533. machine and less activity provides less random events: a vicious circle.
  1534. C</dev/urandom> solves this dilemma more pragmatically by simply returning
  1535. predictable "random" numbers. SomeC< /dev/urandom> emulation software
  1536. however actually seems to implement C</dev/random> semantics. Caveat emptor.
  1537.  
  1538. I've been pointed to two such daemons by Mik Firestone <mik@@speed.stdio._com>
  1539. who has used them on Solaris 8: 
  1540.  
  1541. =over
  1542.  
  1543. =item 1
  1544.  
  1545. Entropy Gathering Daemon (EGD) at L<http://www.lothar.com/tech/crypto/>
  1546.  
  1547. =item 2
  1548.  
  1549. Pseudo-random number generating daemon (PRNGD) at
  1550. L<http://www.aet.tu-cottbus.de/personen/jaenicke/postfix_tls/prngd.html>
  1551.  
  1552. =back
  1553.  
  1554. If you are using the low level API functions to communicate with other
  1555. SSL implementations, you would do well to call
  1556.  
  1557.     Net::SSLeay::CTX_set_options($ctx, &Net::SSLeay::OP_ALL)
  1558.          and die_if_ssl_error("ssl ctx set options");
  1559.  
  1560. to cope with some well know bugs in some other SSL
  1561. implementations. The high level API functions always set all known
  1562. compatibility options.
  1563.  
  1564. Sometimes C<sslcat()> (and the high level HTTPS functions that build on it)
  1565. is too fast in signaling the EOF to legacy HTTPS servers. This causes
  1566. the server to return empty page. To work around this problem you can
  1567. set the global variable
  1568.  
  1569.     $Net::SSLeay::slowly = 1;   # Add sleep so broken servers can keep up
  1570.  
  1571. HTTP/1.1 is not supported. Specifically this module does not know to
  1572. issue or serve multiple http requests per connection. This is a serious
  1573. shortcoming, but using the SSL session cache on your server helps to
  1574. alleviate the CPU load somewhat.
  1575.  
  1576. As of version 1.09 many newer OpenSSL auxiliary functions were
  1577. added (from C<REM_AUTOMATICALLY_GENERATED_1_09> onwards in C<SSLeay.xs>).
  1578. Unfortunately I have not had any opportunity to test these. Some of
  1579. them are trivial enough that I believe they "just work", but others
  1580. have rather complex interfaces with function pointers and all. In these
  1581. cases you should proceed wit great caution.
  1582.  
  1583. This module defaults to using OpenSSL automatic protocol negotiation
  1584. code for automatically detecting the version of the SSL protocol
  1585. that the other end talks. With most web servers this works just
  1586. fine, but once in a while I get complaints from people that the module
  1587. does not work with some web servers. Usually this can be solved
  1588. by explicitly setting the protocol version, e.g.
  1589.  
  1590.    $Net::SSLeay::ssl_version = 2;  # Insist on SSLv2
  1591.    $Net::SSLeay::ssl_version = 3;  # Insist on SSLv3
  1592.    $Net::SSLeay::ssl_version = 10; # Insist on TLSv1
  1593.  
  1594. Although the autonegotiation is nice to have, the SSL standards
  1595. do not formally specify any such mechanism. Most of the world has
  1596. accepted the SSLeay/OpenSSL way of doing it as the de facto standard. But
  1597. for the few that think differently, you have to explicitly speak
  1598. the correct version. This is not really a bug, but rather a deficiency
  1599. in the standards. If a site refuses to respond or sends back some
  1600. nonsensical error codes (at the SSL handshake level), try this option
  1601. before mailing me.
  1602.  
  1603. The high level API returns the certificate of the peer, thus allowing
  1604. one to check what certificate was supplied. However, you will only be
  1605. able to check the certificate after the fact, i.e. you already sent
  1606. your form data by the time you find out that you did not trust them,
  1607. oops.
  1608.  
  1609. So, while being able to know the certificate after the fact is surely
  1610. useful, the security minded would still choose to do the connection
  1611. and certificate verification first and only then exchange data
  1612. with the site. Currently none of the high level API functions do
  1613. this, thus you would have to program it using the low level API. A
  1614. good place to start is to see how the C<Net::SSLeay::http_cat()> function
  1615. is implemented.
  1616.  
  1617. The high level API functions use a global file handle C<SSLCAT_S>
  1618. internally. This really should not be a problem because there is no
  1619. way to interleave the high level API functions, unless you use threads
  1620. (but threads are not very well supported in perl anyway (as of version
  1621. 5.6.1). However, you may run into problems if you call undocumented
  1622. internal functions in an interleaved fashion.
  1623.  
  1624. =head1 DIAGNOSTICS
  1625.  
  1626. =over
  1627.  
  1628. =item Random number generator not seeded!!!
  1629.  
  1630. B<(W)> This warning indicates that C<randomize()> was not able to read
  1631. C</dev/random> or C</dev/urandom>, possibly because your system does not
  1632. have them or they are differently named. You can still use SSL, but
  1633. the encryption will not be as strong.
  1634.  
  1635. =item open_tcp_connection: destination host not found:`server' (port 123) ($!)
  1636.  
  1637. Name lookup for host named C<server> failed.
  1638.  
  1639. =item open_tcp_connection: failed `server', 123 ($!)
  1640.  
  1641. The name was resolved, but establising the TCP connection failed.
  1642.  
  1643. =item msg 123: 1 - error:140770F8:SSL routines:SSL23_GET_SERVER_HELLO:unknown proto
  1644.  
  1645. SSLeay error string. The first number (123) is the PID, the second number
  1646. (1) indicates the position of the error message in SSLeay error stack.
  1647. You often see a pile of these messages as errors cascade.
  1648.  
  1649. =item msg 123: 1 - error:02001002::lib(2) :func(1) :reason(2)
  1650.  
  1651. The same as above, but you didn't call load_error_strings() so SSLeay
  1652. couldn't verbosely explain the error. You can still find out what it
  1653. means with this command:
  1654.  
  1655.     /usr/local/ssl/bin/ssleay errstr 02001002
  1656.  
  1657. =item Password is being asked for private key
  1658.  
  1659. This is normal behaviour if your private key is encrypted. Either
  1660. you have to supply the password or you have to use an unencrypted
  1661. private key. Scan OpenSSL.org for the FAQ that explains how to
  1662. do this (or just study examples/makecert.pl which is used
  1663. during C<make test> to do just that).
  1664.  
  1665. =back
  1666.  
  1667. =head1 BUGS AND SUPPORT
  1668.  
  1669. Please report any bugs or feature requests to
  1670. C<bug-Net-SSLeay at rt.cpan.org>, or through the web interface at
  1671. L<http://rt.cpan.org/Public/Dist/Display.html?Name=Net-SSLeay>.
  1672. I will be notified, and then you'll automatically be notified of progress on
  1673. your bug as I make changes.
  1674.  
  1675. Subversion access to the latest source code etc can be obtained at
  1676. L<http://alioth.debian.org/projects/net-ssleay>
  1677.  
  1678. The developer mailing list (for people interested in contributing
  1679. to the source code) can be found at
  1680. L<http://lists.alioth.debian.org/mailman/listinfo/net-ssleay-devel>
  1681.  
  1682. You can find documentation for this module with the C<perldoc> command.
  1683.  
  1684.     perldoc Net::SSLeay
  1685.  
  1686. You can also look for information at:
  1687.  
  1688. =over 4
  1689.  
  1690. =item * AnnoCPAN: Annotated CPAN documentation
  1691.  
  1692. L<http://annocpan.org/dist/Net-SSLeay>
  1693.  
  1694. =item * CPAN Ratings
  1695.  
  1696. L<http://cpanratings.perl.org/d/Net-SSLeay>
  1697.  
  1698. =item * Search CPAN
  1699.  
  1700. L<http://search.cpan.org/dist/Net-SSLeay>
  1701.  
  1702. =back
  1703.  
  1704. Commercial support for Net::SSLeay may be obtained from
  1705.  
  1706.    Symlabs (netssleay@symlabs.com)
  1707.    Tel: +351-214.222.630
  1708.    Fax: +351-214.222.637
  1709.  
  1710. =head1 AUTHOR
  1711.  
  1712. Maintained by Mike McCauley and Florian Ragwitz since November 2005
  1713.  
  1714. Originally written by Sampo KellomΣki <sampo@symlabs.com>
  1715.  
  1716. =head1 COPYRIGHT
  1717.  
  1718. Copyright (c) 1996-2003 Sampo KellomΣki <sampo@symlabs.com>
  1719.  
  1720. Copyright (C) 2005-2006 Florian Ragwitz <rafl@debian.org>
  1721.  
  1722. Copyright (C) 2005 Mike McCauley <mikem@open.com.au>
  1723.  
  1724. All Rights Reserved.
  1725.  
  1726. Distribution and use of this module is under the same terms as the
  1727. OpenSSL package itself (i.e. free, but mandatory attribution; NO
  1728. WARRANTY). Please consult LICENSE file in the root of the OpenSSL
  1729. distribution.
  1730.  
  1731. While the source distribution of this perl module does not contain
  1732. Eric's or OpenSSL's code, if you use this module you will use OpenSSL
  1733. library. Please give Eric and OpenSSL team credit (as required by
  1734. their licenses).
  1735.  
  1736. And remember, you, and nobody else but you, are responsible for
  1737. auditing this module and OpenSSL library for security problems,
  1738. backdoors, and general suitability for your application.
  1739.  
  1740. =head1 SEE ALSO
  1741.  
  1742.   Net::SSLeay::Handle                      - File handle interface
  1743.   ./examples                               - Example servers and a clients
  1744.   <http://www.openssl.org/>                - OpenSSL source, documentation, etc
  1745.   openssl-users-request@openssl.org        - General OpenSSL mailing list
  1746.   <http://www.ietf.org/rfc/rfc2246.txt>    - TLS 1.0 specification
  1747.   <http://www.w3c.org>                     - HTTP specifications
  1748.   <http://www.ietf.org/rfc/rfc2617.txt>    - How to send password
  1749.   <http://www.lothar.com/tech/crypto/>     - Entropy Gathering Daemon (EGD)
  1750.   <http://www.aet.tu-cottbus.de/personen/jaenicke/postfix_tls/prngd.html>
  1751.                            - pseudo-random number generating daemon (PRNGD)
  1752.   perl(1)
  1753.   perlref(1)
  1754.   perllol(1)
  1755.   perldoc ~openssl/doc/ssl/SSL_CTX_set_verify.pod
  1756.  
  1757. =cut
  1758.  
  1759. # ';
  1760.  
  1761. ### Some methods that are macros in C
  1762.  
  1763. sub want_nothing { want(shift) == 1 }
  1764. sub want_read { want(shift) == 2 }
  1765. sub want_write { want(shift) == 3 }
  1766. sub want_X509_lookup { want(shift) == 4 }
  1767.  
  1768. ###
  1769. ### Open TCP stream to given host and port, looking up the details
  1770. ### from system databases or DNS.
  1771. ###
  1772.  
  1773. sub open_tcp_connection {
  1774.     my ($dest_serv, $port) = @_;
  1775.     my ($errs);
  1776.     
  1777.     $port = getservbyname($port, 'tcp') unless $port =~ /^\d+$/;
  1778.     my $dest_serv_ip = gethostbyname($dest_serv);
  1779.     unless (defined($dest_serv_ip)) {
  1780.     $errs = "$0 $$: open_tcp_connection: destination host not found:"
  1781.             . " `$dest_serv' (port $port) ($!)\n";
  1782.     warn $errs if $trace;
  1783.         return wantarray ? (0, $errs) : 0;
  1784.     }
  1785.     my $sin = sockaddr_in($port, $dest_serv_ip);
  1786.     
  1787.     warn "Opening connection to $dest_serv:$port (" .
  1788.     inet_ntoa($dest_serv_ip) . ")" if $trace>2;
  1789.     
  1790.     my $proto = getprotobyname('tcp');
  1791.     if (socket (SSLCAT_S, &PF_INET(), &SOCK_STREAM(), $proto)) {
  1792.         warn "next connect" if $trace>3;
  1793.         if (CORE::connect (SSLCAT_S, $sin)) {
  1794.             my $old_out = select (SSLCAT_S); $| = 1; select ($old_out);
  1795.             warn "connected to $dest_serv, $port" if $trace>3;
  1796.             return wantarray ? (1, undef) : 1; # Success
  1797.         }
  1798.     }
  1799.     $errs = "$0 $$: open_tcp_connection: failed `$dest_serv', $port ($!)\n";
  1800.     warn $errs if $trace;
  1801.     close SSLCAT_S;
  1802.     return wantarray ? (0, $errs) : 0; # Fail
  1803. }
  1804.  
  1805. ### Open connection via standard web proxy, if one was defined
  1806. ### using set_proxy().
  1807.  
  1808. sub open_proxy_tcp_connection {
  1809.     my ($dest_serv, $port) = @_;
  1810.     return open_tcp_connection($dest_serv, $port) if !$proxyhost;
  1811.     
  1812.     warn "Connect via proxy: $proxyhost:$proxyport" if $trace>2;
  1813.     my ($ret, $errs) = open_tcp_connection($proxyhost, $proxyport);
  1814.     return wantarray ? (0, $errs) : 0 if !$ret;  # Connection fail
  1815.     
  1816.     warn "Asking proxy to connect to $dest_serv:$port" if $trace>2;
  1817.     #print SSLCAT_S "CONNECT $dest_serv:$port HTTP/1.0$proxyauth$CRLF$CRLF";
  1818.     #my $line = <SSLCAT_S>;   # *** bug? Mixing stdio with syscall read?
  1819.     ($ret, $errs) =
  1820.     tcp_write_all("CONNECT $dest_serv:$port HTTP/1.0$proxyauth$CRLF$CRLF");
  1821.     return wantarray ? (0,$errs) : 0 if $errs;
  1822.     ($line, $errs) = tcp_read_until($CRLF . $CRLF, 1024);
  1823.     warn "Proxy response: $line" if $trace>2;
  1824.     return wantarray ? (0,$errs) : 0 if $errs;
  1825.     return wantarray ? (1,'') : 1;  # Success
  1826. }
  1827.  
  1828. ###
  1829. ### read and write helpers that block
  1830. ###
  1831.  
  1832. sub debug_read {
  1833.     my ($replyr, $gotr) = @_;
  1834.     my $vm = $trace>2 && $linux_debug ?
  1835.     (split ' ', `cat /proc/$$/stat`)[22] : 'vm_unknown';
  1836.     warn "  got " . blength($$gotr) . ':'
  1837.     . blength($$replyr) . " bytes (VM=$vm).\n" if $trace == 3;
  1838.     warn "  got `$$gotr' (" . blength($$gotr) . ':'
  1839.     . blength($$replyr) . " bytes, VM=$vm)\n" if $trace>3;
  1840. }
  1841.  
  1842. sub ssl_read_all {
  1843.     my ($ssl,$how_much) = @_;
  1844.     $how_much = 2000000000 unless $how_much;
  1845.     my ($got, $errs);
  1846.     my $reply = '';
  1847.  
  1848.     while ($how_much > 0) {
  1849.         $got = Net::SSLeay::read($ssl,
  1850.                 ($how_much > 32768) ? 32768 : $how_much
  1851.         );
  1852.         last if $errs = print_errs('SSL_read');
  1853.         $how_much -= blength($got);
  1854.         debug_read(\$reply, \$got) if $trace>1;
  1855.         last if $got eq '';  # EOF
  1856.         $reply .= $got;
  1857.     }
  1858.  
  1859.     return wantarray ? ($reply, $errs) : $reply;
  1860. }
  1861.  
  1862. sub tcp_read_all {
  1863.     my ($how_much) = @_;
  1864.     $how_much = 2000000000 unless $how_much;
  1865.     my ($n, $got, $errs);
  1866.     my $reply = '';
  1867.  
  1868.     my $bsize = 0x10000;
  1869.     while ($how_much > 0) {
  1870.     $n = sysread(SSLCAT_S,$got, (($bsize < $how_much) ? $bsize : $how_much));
  1871.     warn "Read error: $! ($n,$how_much)" unless defined $n;
  1872.     last if !$n;  # EOF
  1873.     $how_much -= $n;
  1874.     debug_read(\$reply, \$got) if $trace>1;
  1875.     $reply .= $got;
  1876.     }
  1877.     return wantarray ? ($reply, $errs) : $reply;
  1878. }
  1879.  
  1880. sub ssl_write_all {
  1881.     my $ssl = $_[0];    
  1882.     my ($data_ref, $errs);
  1883.     if (ref $_[1]) {
  1884.     $data_ref = $_[1];
  1885.     } else {
  1886.     $data_ref = \$_[1];
  1887.     }
  1888.     my ($wrote, $written, $to_write) = (0,0, blength($$data_ref));
  1889.     my $vm = $trace>2 && $linux_debug ?
  1890.     (split ' ', `cat /proc/$$/stat`)[22] : 'vm_unknown';
  1891.     warn "  write_all VM at entry=$vm\n" if $trace>2;
  1892.     while ($to_write) {
  1893.     #sleep 1; # *** DEBUG
  1894.     warn "partial `$$data_ref'\n" if $trace>3;
  1895.     $wrote = write_partial($ssl, $written, $to_write, $$data_ref);
  1896.     if (defined $wrote && ($wrote > 0)) {  # write_partial can return -1
  1897.         $written += $wrote;
  1898.         $to_write -= $wrote;
  1899.     } else {
  1900.       if (defined $wrote) {
  1901.         # check error conditions via SSL_get_error per man page
  1902.         if ( my $sslerr = get_error($ssl, $wrote) ) {
  1903.           my $errstr = ERR_error_string($sslerr);
  1904.           my $errname = '';
  1905.           SWITCH: {
  1906.         $sslerr == constant("ERROR_NONE") && do {
  1907.           # according to map page SSL_get_error(3ssl):
  1908.           #  The TLS/SSL I/O operation completed.  
  1909.           #  This result code is returned if and only if ret > 0
  1910.                   # so if we received it here complain...
  1911.           warn "ERROR_NONE unexpected with invalid return value!" 
  1912.             if $trace;
  1913.           $errname = "SSL_ERROR_NONE";
  1914.         };
  1915.         $sslerr == constant("ERROR_WANT_READ") && do {
  1916.           # operation did not complete, call again later, so do not
  1917.           # set errname and empty err_que since this is a known
  1918.           # error that is expected but, we should continue to try
  1919.           # writing the rest of our data with same io call and params.
  1920.           warn "ERROR_WANT_READ (TLS/SSL Handshake, will continue)\n"
  1921.             if $trace;
  1922.           print_errs('SSL_write(want read)');
  1923.           last SWITCH;
  1924.         };
  1925.         $sslerr == constant("ERROR_WANT_WRITE") && do {
  1926.           # operation did not complete, call again later, so do not
  1927.           # set errname and empty err_que since this is a known
  1928.           # error that is expected but, we should continue to try
  1929.           # writing the rest of our data with same io call and params.
  1930.           warn "ERROR_WANT_WRITE (TLS/SSL Handshake, will continue)\n"
  1931.             if $trace;
  1932.           print_errs('SSL_write(want write)');
  1933.           last SWITCH;
  1934.         };
  1935.         $sslerr == constant("ERROR_ZERO_RETURN") && do {
  1936.           # valid protocol closure from other side, no longer able to
  1937.           # write, since there is no longer a session...
  1938.           warn "ERROR_ZERO_RETURN($wrote): TLS/SSLv3 Closure alert\n"
  1939.             if $trace;
  1940.           $errname = "SSL_ERROR_ZERO_RETURN";
  1941.           last SWITCH;
  1942.         };
  1943.         $sslerr == constant("ERROR_SSL") && do {
  1944.           # library/protocol error
  1945.           warn "ERROR_SSL($wrote): Library/Protocol error occured\n"
  1946.             if $trace;
  1947.           $errname = "SSL_ERROR_SSL";
  1948.           last SWITCH;
  1949.         };
  1950.         $sslerr == constant("ERROR_WANT_CONNECT") && do {
  1951.           # according to man page, should never happen on call to
  1952.           # SSL_write, so complain, but handle as known error type
  1953.           warn "ERROR_WANT_CONNECT: Unexpected error for SSL_write\n"
  1954.             if $trace;
  1955.           $errname = "SSL_ERROR_WANT_CONNECT";
  1956.           last SWITCH;
  1957.         };
  1958.         $sslerr == constant("ERROR_WANT_ACCEPT") && do { 
  1959.           # according to man page, should never happen on call to
  1960.           # SSL_write, so complain, but handle as known error type
  1961.           warn "ERROR_WANT_ACCEPT: Unexpected error for SSL_write\n"
  1962.             if $trace;
  1963.           $errname = "SSL_ERROR_WANT_ACCEPT";
  1964.           last SWITCH;
  1965.         };
  1966.         $sslerr == constant("ERROR_WANT_X509_LOOKUP") && do {
  1967.           # operation did not complete: waiting on call back,  
  1968.           # call again later, so do not set errname and empty err_que
  1969.           # since this is a known error that is expected but, we should
  1970.           # continue to try writing the rest of our data with same io
  1971.           # call parameter.
  1972.           warn "ERROR_WANT_X509_LOOKUP: (Cert Callback asked for in ".
  1973.             "SSL_write will contine)\n" if $trace;
  1974.           print_errs('SSL_write(want x509');
  1975.           last SWITCH;
  1976.         };
  1977.         $sslerr == constant("ERROR_SYSCALL") && do {
  1978.           # some IO error occured. According to man page: 
  1979.           # Check retval, ERR, fallback to errno
  1980.           if ($wrote==0) { # EOF
  1981.             warn "ERROR_SYSCALL($wrote): EOF violates protocol.\n"
  1982.               if $trace;
  1983.             $errname = "SSL_ERROR_SYSCALL(EOF)";
  1984.           } else { # -1 underlying BIO error reported.
  1985.             # check error que for details, don't set errname since we
  1986.             # are directly appending to errs
  1987.             my $chkerrs = print_errs('SSL_write (syscall)');
  1988.             if ($chkerrs) { 
  1989.               warn "ERROR_SYSCALL($wrote): Have errors\n" if $trace;
  1990.               $errs .= "ssl_write_all $$: 1 - ERROR_SYSCALL($wrote,".
  1991.             "$sslerr,$errstr,$!)\n$chkerrs";
  1992.             } else { # que was empty, use errno
  1993.               warn "ERROR_SYSCALL($wrote): errno($!)\n" if $trace;
  1994.               $errs .= "ssl_write_all $$: 1 - ERROR_SYSCALL($wrote,".
  1995.             "$sslerr) : $!\n";
  1996.             }
  1997.           }
  1998.           last SWITCH;
  1999.         };
  2000.         warn "Unhandled val $sslerr from SSL_get_error(SSL,$wrote)\n"
  2001.           if $trace;
  2002.         $errname = "SSL_ERROR_?($sslerr)";
  2003.           } # end of SWITCH block
  2004.           if ($errname) { # if we had an errname set add the error
  2005.         $errs .= "ssl_write_all $$: 1 - $errname($wrote,$sslerr,".
  2006.           "$errstr,$!)\n";
  2007.           }          
  2008.         } # endif on have SSL_get_error val
  2009.       } # endif on $wrote defined
  2010.     } # endelse on $wrote > 0
  2011.     $vm = $trace>2 && $linux_debug ?
  2012.         (split ' ', `cat /proc/$$/stat`)[22] : 'vm_unknown';
  2013.     warn "  written so far $wrote:$written bytes (VM=$vm)\n" if $trace>2;
  2014.     # append remaining errors in que and report if errs exist
  2015.     $errs .= print_errs('SSL_write');
  2016.     return (wantarray ? (undef, $errs) : undef) if $errs;
  2017.     }
  2018.     return wantarray ? ($written, $errs) : $written;
  2019. }
  2020.  
  2021. sub tcp_write_all {
  2022.     my ($data_ref, $errs);
  2023.     if (ref $_[0]) {
  2024.     $data_ref = $_[0];
  2025.     } else {
  2026.     $data_ref = \$_[0];
  2027.     }
  2028.     my ($wrote, $written, $to_write) = (0,0, blength($$data_ref));
  2029.     my $vm = $trace>2 && $linux_debug ?
  2030.     (split ' ', `cat /proc/$$/stat`)[22] : 'vm_unknown';
  2031.     warn "  write_all VM at entry=$vm to_write=$to_write\n" if $trace>2;
  2032.     while ($to_write) {
  2033.     warn "partial `$$data_ref'\n" if $trace>3;
  2034.     $wrote = syswrite(SSLCAT_S, $$data_ref, $to_write, $written);
  2035.     if (defined $wrote && ($wrote > 0)) {  # write_partial can return -1
  2036.         $written += $wrote;
  2037.         $to_write -= $wrote;
  2038.     } elsif (!defined($wrote)) {
  2039.         warn "tcp_write_all: $!";
  2040.         return (wantarray ? (undef, "$!") : undef);
  2041.     }
  2042.     $vm = $trace>2 && $linux_debug ?
  2043.         (split ' ', `cat /proc/$$/stat`)[22] : 'vm_unknown';
  2044.     warn "  written so far $wrote:$written bytes (VM=$vm)\n" if $trace>2;
  2045.     }
  2046.     return wantarray ? ($written, '') : $written;
  2047. }
  2048.  
  2049. ### from patch by Clinton Wong <clintdw@netcom.com>
  2050.  
  2051. # ssl_read_until($ssl [, $delimit [, $max_length]])
  2052. #  if $delimit missing, use $/ if it exists, otherwise use \n
  2053. #  read until delimiter reached, up to $max_length chars if defined
  2054.  
  2055. sub ssl_read_until ($;$$) {
  2056.     my ($ssl,$delim, $max_length) = @_;
  2057.     local $[;
  2058.  
  2059.     # guess the delim string if missing
  2060.     if ( ! defined $delim ) {           
  2061.       if ( defined $/ && length $/  ) { $delim = $/ }
  2062.       else { $delim = "\n" }      # Note: \n,$/ value depends on the platform
  2063.     }
  2064.     my $len_delim = length $delim;
  2065.  
  2066.     my ($got);
  2067.     my $reply = '';
  2068.     
  2069.     # If we have OpenSSL 0.9.6a or later, we can use SSL_peek to
  2070.     # speed things up.
  2071.     # N.B. 0.9.6a has security problems, so the support for
  2072.     #      anything earlier than 0.9.6e will be dropped soon.
  2073.     if (&Net::SSLeay::OPENSSL_VERSION_NUMBER >= 0x0090601f) {
  2074.     $max_length = 2000000000 unless (defined $max_length);
  2075.     my ($pending, $peek_length, $found, $done);
  2076.     while (blength($reply) < $max_length and !$done) {
  2077.         #Block if necessary until we get some data
  2078.         $got = Net::SSLeay::peek($ssl,1);
  2079.         last if print_errs('SSL_peek');
  2080.  
  2081.         $pending = Net::SSLeay::pending($ssl) + blength($reply);
  2082.         $peek_length = ($pending > $max_length) ? $max_length : $pending;
  2083.         $peek_length -= blength($reply);
  2084.         $got = Net::SSLeay::peek($ssl, $peek_length);
  2085.         last if print_errs('SSL_peek');
  2086.         $peek_length = blength($got);
  2087.         
  2088.         #$found = index($got, $delim);  # Old and broken
  2089.         
  2090.         # the delimiter may be split across two gets, so we prepend
  2091.         # a little from the last get onto this one before we check
  2092.         # for a match
  2093.         my $match;
  2094.         if(blength($reply) >= blength($delim) - 1) {
  2095.         #if what we've read so far is greater or equal
  2096.         #in length of what we need to prepatch
  2097.         $match = substr $reply, blength($reply) - blength($delim) + 1;
  2098.         } else {
  2099.         $match = $reply;
  2100.         }
  2101.  
  2102.         $match .= $got;
  2103.         $found = index($match, $delim);
  2104.  
  2105.         if ($found > -1) {
  2106.         #$got = Net::SSLeay::read($ssl, $found+$len_delim);
  2107.         #read up to the end of the delimiter
  2108.         $got = Net::SSLeay::read($ssl,
  2109.                      $found + $len_delim
  2110.                      - ((blength $match) - (blength $got)));
  2111.         $done = 1;
  2112.         } else {
  2113.         $got = Net::SSLeay::read($ssl, $peek_length);
  2114.         $done = 1 if ($peek_length == $max_length - blength($reply));
  2115.         } 
  2116.  
  2117.         last if print_errs('SSL_read');
  2118.         debug_read(\$reply, \$got) if $trace>1;
  2119.         last if $got eq '';
  2120.         $reply .= $got;
  2121.     }
  2122.     } else {
  2123.     while (!defined $max_length || length $reply < $max_length) {
  2124.         $got = Net::SSLeay::read($ssl,1);  # one by one
  2125.         last if print_errs('SSL_read');
  2126.         debug_read(\$reply, \$got) if $trace>1;
  2127.         last if $got eq '';
  2128.         $reply .= $got;
  2129.         last if $len_delim
  2130.         && substr($reply, blength($reply)-$len_delim) eq $delim;
  2131.     }
  2132.     }
  2133.     return $reply;
  2134. }
  2135.  
  2136. sub tcp_read_until {
  2137.     my ($delim, $max_length) = @_;
  2138.     local $[;
  2139.  
  2140.     # guess the delim string if missing
  2141.     if ( ! defined $delim ) {           
  2142.       if ( defined $/ && length $/  ) { $delim = $/ }
  2143.       else { $delim = "\n" }      # Note: \n,$/ value depends on the platform
  2144.     }
  2145.     my $len_delim = length $delim;
  2146.  
  2147.     my ($n,$got);
  2148.     my $reply = '';
  2149.     
  2150.     while (!defined $max_length || length $reply < $max_length) {
  2151.     $n = sysread(SSLCAT_S, $got, 1);  # one by one
  2152.     warn "tcp_read_until: $!" if !defined $n;
  2153.     debug_read(\$reply, \$got) if $trace>1;
  2154.     last if !$n;  # EOF
  2155.     $reply .= $got;
  2156.     last if $len_delim
  2157.         && substr($reply, blength($reply)-$len_delim) eq $delim;
  2158.     }
  2159.     return $reply;
  2160. }
  2161.  
  2162. # ssl_read_CRLF($ssl [, $max_length])
  2163. sub ssl_read_CRLF ($;$) { ssl_read_until($_[0], $CRLF, $_[1]) }
  2164. sub tcp_read_CRLF { tcp_read_until($CRLF, $_[0]) }
  2165.  
  2166. # ssl_write_CRLF($ssl, $message) writes $message and appends CRLF
  2167. sub ssl_write_CRLF ($$) { 
  2168.   # the next line uses less memory but might use more network packets
  2169.   return ssl_write_all($_[0], $_[1]) + ssl_write_all($_[0], $CRLF);
  2170.  
  2171.   # the next few lines do the same thing at the expense of memory, with
  2172.   # the chance that it will use less packets, since CRLF is in the original
  2173.   # message and won't be sent separately.
  2174.  
  2175.   #my $data_ref;
  2176.   #if (ref $_[1]) { $data_ref = $_[1] }
  2177.   # else { $data_ref = \$_[1] }
  2178.   #my $message = $$data_ref . $CRLF;
  2179.   #return ssl_write_all($_[0], \$message);
  2180. }
  2181.  
  2182. sub tcp_write_CRLF { 
  2183.   # the next line uses less memory but might use more network packets
  2184.   return tcp_write_all($_[0]) + tcp_write_all($CRLF);
  2185.  
  2186.   # the next few lines do the same thing at the expense of memory, with
  2187.   # the chance that it will use less packets, since CRLF is in the original
  2188.   # message and won't be sent separately.
  2189.  
  2190.   #my $data_ref;
  2191.   #if (ref $_[1]) { $data_ref = $_[1] }
  2192.   # else { $data_ref = \$_[1] }
  2193.   #my $message = $$data_ref . $CRLF;
  2194.   #return tcp_write_all($_[0], \$message);
  2195. }
  2196.  
  2197. ### Quickly print out with whom we're talking
  2198.  
  2199. sub dump_peer_certificate ($) {
  2200.     my ($ssl) = @_;
  2201.     my $cert = get_peer_certificate($ssl);
  2202.     return if print_errs('get_peer_certificate');
  2203.     print "no cert defined\n" if !defined($cert);
  2204.     # Cipher=NONE with empty cert fix
  2205.     if (!defined($cert) || ($cert == 0)) {
  2206.     warn "cert = `$cert'\n" if $trace;
  2207.     return "Subject Name: undefined\nIssuer  Name: undefined\n";
  2208.     } else {
  2209.     my $x = 'Subject Name: '
  2210.         . X509_NAME_oneline(X509_get_subject_name($cert)) . "\n"
  2211.         . 'Issuer  Name: '
  2212.             . X509_NAME_oneline(X509_get_issuer_name($cert))  . "\n";
  2213.     Net::SSLeay::X509_free($cert);
  2214.     return $x;
  2215.     }
  2216. }
  2217.  
  2218. ### Arrange some randomness for eay PRNG
  2219.  
  2220. sub randomize (;$$) {
  2221.     my ($rn_seed_file, $seed, $egd_path) = @_;
  2222.     my $rnsf = defined($rn_seed_file) && -r $rn_seed_file;
  2223.  
  2224.     $egd_path = '';
  2225.     $egd_path = $ENV{'EGD_PATH'} if $ENV{'EGD_PATH'};
  2226.     
  2227.     RAND_seed(rand() + $$);  # Stir it with time and pid
  2228.     
  2229.     unless ($rnsf || -r $Net::SSLeay::random_device || $seed || -S $egd_path) {
  2230.     warn "Random number generator not seeded!!!" if $trace;
  2231.     }
  2232.     
  2233.     RAND_load_file($rn_seed_file, -s _) if $rnsf;
  2234.     RAND_seed($seed) if $seed;
  2235.     RAND_seed($ENV{RND_SEED}) if $ENV{RND_SEED};
  2236.     RAND_egd($egd_path) if -e $egd_path && -S _;
  2237.     RAND_load_file($Net::SSLeay::random_device, $Net::SSLeay::how_random/8)
  2238.     if -r $Net::SSLeay::random_device;
  2239. }
  2240.  
  2241. sub new_x_ctx {
  2242.     if    ($ssl_version == 2)  { $ctx = CTX_v2_new(); }
  2243.     elsif ($ssl_version == 3)  { $ctx = CTX_v3_new(); }
  2244.     elsif ($ssl_version == 10) { $ctx = CTX_tlsv1_new(); }
  2245.     else                       { $ctx = CTX_new(); }
  2246.     return $ctx;
  2247. }
  2248.  
  2249. ###
  2250. ### Basic request - response primitive (don't use for https)
  2251. ###
  2252.  
  2253. sub sslcat { # address, port, message, $crt, $key --> reply / (reply,errs,cert)
  2254.     my ($dest_serv, $port, $out_message, $crt_path, $key_path) = @_;
  2255.     my ($ctx, $ssl, $got, $errs, $written);
  2256.     
  2257.     ($got, $errs) = open_proxy_tcp_connection($dest_serv, $port);
  2258.     return (wantarray ? (undef, $errs) : undef) unless $got;
  2259.     
  2260.     ### Do SSL negotiation stuff
  2261.         
  2262.     warn "Creating SSL $ssl_version context...\n" if $trace>2;
  2263.     load_error_strings();         # Some bloat, but I'm after ease of use
  2264.     SSLeay_add_ssl_algorithms();  # and debuggability.
  2265.     randomize();
  2266.     
  2267.     $ctx = new_x_ctx();
  2268.     goto cleanup2 if $errs = print_errs('CTX_new') or !$ctx;
  2269.  
  2270.     CTX_set_options($ctx, &OP_ALL);
  2271.     goto cleanup2 if $errs = print_errs('CTX_set_options');
  2272.  
  2273.     warn "Cert `$crt_path' given without key" if $crt_path && !$key_path;
  2274.     set_cert_and_key($ctx, $crt_path, $key_path) if $crt_path;
  2275.     
  2276.     warn "Creating SSL connection (context was '$ctx')...\n" if $trace>2;
  2277.     $ssl = new($ctx);
  2278.     goto cleanup if $errs = print_errs('SSL_new') or !$ssl;
  2279.     
  2280.     warn "Setting fd (ctx $ctx, con $ssl)...\n" if $trace>2;
  2281.     set_fd($ssl, fileno(SSLCAT_S));
  2282.     goto cleanup if $errs = print_errs('set_fd');
  2283.     
  2284.     warn "Entering SSL negotiation phase...\n" if $trace>2;
  2285.  
  2286.     if ($trace>2) {
  2287.     my $i = 0;
  2288.     my $p = '';
  2289.     my $cipher_list = 'Cipher list: ';
  2290.     $p=Net::SSLeay::get_cipher_list($ssl,$i);
  2291.     $cipher_list .= $p if $p;
  2292.     do {
  2293.         $i++;
  2294.         $cipher_list .= ', ' . $p if $p;
  2295.         $p=Net::SSLeay::get_cipher_list($ssl,$i);
  2296.     } while $p;
  2297.     $cipher_list .= '\n';
  2298.     warn $cipher_list;
  2299.     }
  2300.     
  2301.     $got = Net::SSLeay::connect($ssl);
  2302.     warn "SSLeay connect returned $got\n" if $trace>2;
  2303.     goto cleanup if $errs = print_errs('SSL_connect');
  2304.     
  2305.     my $server_cert = get_peer_certificate($ssl);
  2306.     print_errs('get_peer_certificate');
  2307.     if ($trace>1) {        
  2308.     warn "Cipher `" . get_cipher($ssl) . "'\n";
  2309.     print_errs('get_ciper');
  2310.     warn dump_peer_certificate($ssl);
  2311.     }
  2312.     
  2313.     ### Connected. Exchange some data (doing repeated tries if necessary).
  2314.         
  2315.     warn "sslcat $$: sending " . blength($out_message) . " bytes...\n"
  2316.     if $trace==3;
  2317.     warn "sslcat $$: sending `$out_message' (" . blength($out_message)
  2318.     . " bytes)...\n" if $trace>3;
  2319.     ($written, $errs) = ssl_write_all($ssl, $out_message);
  2320.     goto cleanup unless $written;
  2321.     
  2322.     sleep $slowly if $slowly;  # Closing too soon can abort broken servers
  2323.     CORE::shutdown SSLCAT_S, 1;  # Half close --> No more output, send EOF to server
  2324.     
  2325.     warn "waiting for reply...\n" if $trace>2;
  2326.     ($got, $errs) = ssl_read_all($ssl);
  2327.     warn "Got " . blength($got) . " bytes.\n" if $trace==3;
  2328.     warn "Got `$got' (" . blength($got) . " bytes)\n" if $trace>3;
  2329.  
  2330. cleanup:        
  2331.     free ($ssl);
  2332.     $errs .= print_errs('SSL_free');
  2333. cleanup2:
  2334.     CTX_free ($ctx);
  2335.     $errs .= print_errs('CTX_free');
  2336.     close SSLCAT_S;    
  2337.     return wantarray ? ($got, $errs, $server_cert) : $got;
  2338. }
  2339.  
  2340. sub tcpcat { # address, port, message, $crt, $key --> reply / (reply,errs,cert)
  2341.     my ($dest_serv, $port, $out_message) = @_;
  2342.     my ($got, $errs, $written);
  2343.     
  2344.     ($got, $errs) = open_proxy_tcp_connection($dest_serv, $port);
  2345.     return (wantarray ? (undef, $errs) : undef) unless $got;
  2346.     
  2347.     ### Connected. Exchange some data (doing repeated tries if necessary).
  2348.         
  2349.     warn "tcpcat $$: sending " . blength($out_message) . " bytes...\n"
  2350.     if $trace==3;
  2351.     warn "tcpcat $$: sending `$out_message' (" . blength($out_message)
  2352.     . " bytes)...\n" if $trace>3;
  2353.     ($written, $errs) = tcp_write_all($out_message);
  2354.     goto cleanup unless $written;
  2355.     
  2356.     sleep $slowly if $slowly;  # Closing too soon can abort broken servers
  2357.     CORE::shutdown SSLCAT_S, 1;  # Half close --> No more output, send EOF to server
  2358.     
  2359.     warn "waiting for reply...\n" if $trace>2;
  2360.     ($got, $errs) = tcp_read_all($ssl);
  2361.     warn "Got " . blength($got) . " bytes.\n" if $trace==3;
  2362.     warn "Got `$got' (" . blength($got) . " bytes)\n" if $trace>3;
  2363.  
  2364. cleanup:
  2365.     close SSLCAT_S;    
  2366.     return wantarray ? ($got, $errs) : $got;
  2367. }
  2368.  
  2369. sub tcpxcat {
  2370.     my ($usessl, $site, $port, $req, $crt_path, $key_path) = @_;
  2371.     if ($usessl) {
  2372.     return sslcat($site, $port, $req, $crt_path, $key_path);
  2373.     } else {
  2374.     return tcpcat($site, $port, $req);
  2375.     }
  2376. }
  2377.  
  2378. ###
  2379. ### Basic request - response primitive, this is different from sslcat
  2380. ###                 because this does not shutdown the connection.
  2381. ###
  2382.  
  2383. sub https_cat { # address, port, message --> returns reply / (reply,errs,cert)
  2384.     my ($dest_serv, $port, $out_message, $crt_path, $key_path) = @_;
  2385.     my ($ctx, $ssl, $got, $errs, $written);
  2386.     
  2387.     ($got, $errs) = open_proxy_tcp_connection($dest_serv, $port);
  2388.     return (wantarray ? (undef, $errs) : undef) unless $got;
  2389.         
  2390.     ### Do SSL negotiation stuff
  2391.         
  2392.     warn "Creating SSL $ssl_version context...\n" if $trace>2;
  2393.     load_error_strings();         # Some bloat, but I'm after ease of use
  2394.     SSLeay_add_ssl_algorithms();  # and debuggability.
  2395.     randomize();
  2396.  
  2397.     $ctx = new_x_ctx();
  2398.     goto cleanup2 if $errs = print_errs('CTX_new') or !$ctx;
  2399.  
  2400.     CTX_set_options($ctx, &OP_ALL);
  2401.     goto cleanup2 if $errs = print_errs('CTX_set_options');
  2402.     
  2403.     warn "Cert `$crt_path' given without key" if $crt_path && !$key_path;
  2404.     set_cert_and_key($ctx, $crt_path, $key_path) if $crt_path;
  2405.     
  2406.     warn "Creating SSL connection (context was '$ctx')...\n" if $trace>2;
  2407.     $ssl = new($ctx);
  2408.     goto cleanup if $errs = print_errs('SSL_new') or !$ssl;
  2409.     
  2410.     warn "Setting fd (ctx $ctx, con $ssl)...\n" if $trace>2;
  2411.     set_fd($ssl, fileno(SSLCAT_S));
  2412.     goto cleanup if $errs = print_errs('set_fd');
  2413.     
  2414.     warn "Entering SSL negotiation phase...\n" if $trace>2;
  2415.     
  2416.     if ($trace>2) {
  2417.     my $i = 0;
  2418.     my $p = '';
  2419.     my $cipher_list = 'Cipher list: ';
  2420.     $p=Net::SSLeay::get_cipher_list($ssl,$i);
  2421.     $cipher_list .= $p if $p;
  2422.     do {
  2423.         $i++;
  2424.         $cipher_list .= ', ' . $p if $p;
  2425.         $p=Net::SSLeay::get_cipher_list($ssl,$i);
  2426.     } while $p;
  2427.     $cipher_list .= '\n';
  2428.     warn $cipher_list;
  2429.     }
  2430.  
  2431.     $got = Net::SSLeay::connect($ssl);
  2432.     warn "SSLeay connect failed" if $trace>2 && $got==0;
  2433.     goto cleanup if $errs = print_errs('SSL_connect');
  2434.     
  2435.     my $server_cert = get_peer_certificate($ssl);
  2436.     print_errs('get_peer_certificate');
  2437.     if ($trace>1) {        
  2438.     warn "Cipher `" . get_cipher($ssl) . "'\n";
  2439.     print_errs('get_ciper');
  2440.     warn dump_peer_certificate($ssl);
  2441.     }
  2442.     
  2443.     ### Connected. Exchange some data (doing repeated tries if necessary).
  2444.         
  2445.     warn "https_cat $$: sending " . blength($out_message) . " bytes...\n"
  2446.     if $trace==3;
  2447.     warn "https_cat $$: sending `$out_message' (" . blength($out_message)
  2448.     . " bytes)...\n" if $trace>3;
  2449.     ($written, $errs) = ssl_write_all($ssl, $out_message);
  2450.     goto cleanup unless $written;
  2451.     
  2452.     warn "waiting for reply...\n" if $trace>2;
  2453.     ($got, $errs) = ssl_read_all($ssl);
  2454.     warn "Got " . blength($got) . " bytes.\n" if $trace==3;
  2455.     warn "Got `$got' (" . blength($got) . " bytes)\n" if $trace>3;
  2456.  
  2457. cleanup:
  2458.     free ($ssl);
  2459.     $errs .= print_errs('SSL_free');
  2460. cleanup2:
  2461.     CTX_free ($ctx);
  2462.     $errs .= print_errs('CTX_free');
  2463.     close SSLCAT_S;    
  2464.     return wantarray ? ($got, $errs, $server_cert) : $got;
  2465. }
  2466.  
  2467. sub http_cat { # address, port, message --> returns reply / (reply,errs,cert)
  2468.     my ($dest_serv, $port, $out_message) = @_;
  2469.     my ($got, $errs, $written);
  2470.     
  2471.     ($got, $errs) = open_proxy_tcp_connection($dest_serv, $port);
  2472.     return (wantarray ? (undef, $errs) : undef) unless $got;
  2473.         
  2474.     ### Connected. Exchange some data (doing repeated tries if necessary).
  2475.         
  2476.     warn "http_cat $$: sending " . blength($out_message) . " bytes...\n"
  2477.     if $trace==3;
  2478.     warn "http_cat $$: sending `$out_message' (" . blength($out_message)
  2479.     . " bytes)...\n" if $trace>3;
  2480.     ($written, $errs) = tcp_write_all($out_message);
  2481.     goto cleanup unless $written;
  2482.     
  2483.     warn "waiting for reply...\n" if $trace>2;
  2484.     ($got, $errs) = tcp_read_all(200000);
  2485.     warn "Got " . blength($got) . " bytes.\n" if $trace==3;
  2486.     warn "Got `$got' (" . blength($got) . " bytes)\n" if $trace>3;
  2487.  
  2488. cleanup:
  2489.     close SSLCAT_S;    
  2490.     return wantarray ? ($got, $errs) : $got;
  2491. }
  2492.  
  2493. sub httpx_cat {
  2494.     my ($usessl, $site, $port, $req, $crt_path, $key_path) = @_;
  2495.     warn "httpx_cat: usessl=$usessl ($site:$port)" if $trace;
  2496.     if ($usessl) {
  2497.     return https_cat($site, $port, $req, $crt_path, $key_path);
  2498.     } else {
  2499.     return http_cat($site, $port, $req);
  2500.     }
  2501. }
  2502.  
  2503. ###
  2504. ### Easy set up of private key and certificate
  2505. ###
  2506.  
  2507. sub set_cert_and_key ($$$) {
  2508.     my ($ctx, $cert_path, $key_path) = @_;    
  2509.     my $errs = '';
  2510.     # Following will ask password unless private key is not encrypted
  2511.     CTX_use_RSAPrivateKey_file ($ctx, $key_path, &FILETYPE_PEM);
  2512.     $errs .= print_errs("private key `$key_path' ($!)");
  2513.     CTX_use_certificate_file ($ctx, $cert_path, &FILETYPE_PEM);
  2514.     $errs .= print_errs("certificate `$cert_path' ($!)");
  2515.     return wantarray ? (undef, $errs) : ($errs eq '');
  2516. }
  2517.  
  2518. ### Old deprecated API
  2519.  
  2520. sub set_server_cert_and_key ($$$) { &set_cert_and_key }
  2521.  
  2522. ### Set up to use web proxy
  2523.  
  2524. sub set_proxy ($$;**) {
  2525.     ($proxyhost, $proxyport, $proxyuser, $proxypass) = @_;
  2526.     require MIME::Base64 if $proxyuser;
  2527.     $proxyauth = $CRLF . 'Proxy-authorization: Basic '
  2528.     . MIME::Base64::encode("$proxyuser:$proxypass", '')
  2529.         if $proxyuser;
  2530. }
  2531.  
  2532. ###
  2533. ### Easy https manipulation routines
  2534. ###
  2535.  
  2536. sub make_form {
  2537.     my (@fields) = @_;
  2538.     my $form;
  2539.     while (@fields) {
  2540.     my ($name, $data) = (shift(@fields), shift(@fields));
  2541.     $data =~ s/([^\w\-.\@\$ ])/sprintf("%%%2.2x",ord($1))/gse;
  2542.         $data =~ tr[ ][+];
  2543.     $form .= "$name=$data&";
  2544.     }
  2545.     chop $form;
  2546.     return $form;
  2547. }
  2548.  
  2549. sub make_headers {
  2550.     my (@headers) = @_;
  2551.     my $headers;
  2552.     while (@headers) {
  2553.     my $header = shift(@headers);
  2554.     my $value = shift(@headers);
  2555.     $header =~ s/:$//;
  2556.     $value =~ s/\x0d?\x0a$//; # because we add it soon, see below
  2557.     $headers .= "$header: $value$CRLF";
  2558.     }
  2559.     return $headers;
  2560. }
  2561.  
  2562. sub do_httpx3 {
  2563.     my ($method, $usessl, $site, $port, $path, $headers,
  2564.     $content, $mime_type, $crt_path, $key_path) = @_;
  2565.     my ($response, $page, $h,$v);
  2566.  
  2567.     if ($content) {
  2568.     $mime_type = "application/x-www-form-urlencoded" unless $mime_type;
  2569.     my $len = blength($content);
  2570.     $content = "Content-Type: $mime_type$CRLF"
  2571.         . "Content-Length: $len$CRLF$CRLF$content";
  2572.     } else {
  2573.     $content = "$CRLF$CRLF";
  2574.     }
  2575.     my $req = "$method $path HTTP/1.0$CRLF";
  2576.     unless (defined $headers && $headers =~ /^Host:/m) {
  2577.         $req .= "Host: $site";
  2578.         unless (($port == 80 && !$usessl) || ($port == 443 && $usessl)) {
  2579.             $req .= ":$port";
  2580.         }
  2581.         $req .= $CRLF;
  2582.     }
  2583.     $req .= (defined $headers ? $headers : '') . "Accept: */*$CRLF$content";    
  2584.  
  2585.     warn "do_httpx3($method,$usessl,$site:$port)" if $trace;
  2586.     my ($http, $errs, $server_cert)
  2587.     = httpx_cat($usessl, $site, $port, $req, $crt_path, $key_path);
  2588.     return (undef, "HTTP/1.0 900 NET OR SSL ERROR$CRLF$CRLF$errs") if $errs;
  2589.     
  2590.     $http = '' if !defined $http;
  2591.     ($headers, $page) = split /\s?\n\s?\n/, $http, 2;
  2592.     warn "headers >$headers< page >>$page<< http >>>$http<<<" if $trace>1;
  2593.     ($response, $headers) = split /\s?\n/, $headers, 2;
  2594.     return ($page, $response, $headers, $server_cert);
  2595. }
  2596.  
  2597. sub do_https3 { splice(@_,1,0) = 1; do_httpx3; }  # Legacy undocumented
  2598.  
  2599. ### do_https2() is a legacy version in the sense that it is unable
  2600. ### to return all instances of duplicate headers.
  2601.  
  2602. sub do_httpx2 {
  2603.     my ($page, $response, $headers, $server_cert) = &do_httpx3;
  2604.     X509_free($server_cert) if defined $server_cert;
  2605.     return ($page, $response,
  2606.         map( { ($h,$v)=/^(\S+)\:\s*(.*)$/; (uc($h),$v); }
  2607.         split(/\s?\n/, $headers)
  2608.         )
  2609.         );
  2610. }
  2611.  
  2612. sub do_https2 { splice(@_,1,0) = 1; do_httpx2; }  # Legacy undocumented
  2613.  
  2614. ### Returns headers as a hash where multiple instances of same header
  2615. ### are handled correctly.
  2616.  
  2617. sub do_httpx4 {
  2618.     my ($page, $response, $headers, $server_cert) = &do_httpx3;
  2619.     X509_free($server_cert) if defined $server_cert;
  2620.     my %hr = ();
  2621.     for my $hh (split /\s?\n/, $headers) {
  2622.     my ($h,$v)=/^(\S+)\:\s*(.*)$/;
  2623.     push @{$hr{uc($h)}}, $v;
  2624.     }
  2625.     return ($page, $response, \%hr);
  2626. }
  2627.  
  2628. sub do_https4 { splice(@_,1,0) = 1; do_httpx4; }  # Legacy undocumented
  2629.  
  2630. # https
  2631.  
  2632. sub get_https  { do_httpx2(GET  => 1, @_) }
  2633. sub post_https { do_httpx2(POST => 1, @_) }
  2634. sub put_https  { do_httpx2(PUT  => 1, @_) }
  2635. sub head_https { do_httpx2(HEAD => 1, @_) }
  2636.  
  2637. sub get_https3  { do_httpx3(GET  => 1, @_) }
  2638. sub post_https3 { do_httpx3(POST => 1, @_) }
  2639. sub put_https3  { do_httpx3(PUT  => 1, @_) }
  2640. sub head_https3 { do_httpx3(HEAD => 1, @_) }
  2641.  
  2642. sub get_https4  { do_httpx4(GET  => 1, @_) }
  2643. sub post_https4 { do_httpx4(POST => 1, @_) }
  2644. sub put_https4  { do_httpx4(PUT  => 1, @_) }
  2645. sub head_https4 { do_httpx4(HEAD => 1, @_) }
  2646.  
  2647. # http
  2648.  
  2649. sub get_http  { do_httpx2(GET  => 0, @_) }
  2650. sub post_http { do_httpx2(POST => 0, @_) }
  2651. sub put_http  { do_httpx2(PUT  => 0, @_) }
  2652. sub head_http { do_httpx2(HEAD => 0, @_) }
  2653.  
  2654. sub get_http3  { do_httpx3(GET  => 0, @_) }
  2655. sub post_http3 { do_httpx3(POST => 0, @_) }
  2656. sub put_http3  { do_httpx3(PUT  => 0, @_) }
  2657. sub head_http3 { do_httpx3(HEAD => 0, @_) }
  2658.  
  2659. sub get_http4  { do_httpx4(GET  => 0, @_) }
  2660. sub post_http4 { do_httpx4(POST => 0, @_) }
  2661. sub put_http4  { do_httpx4(PUT  => 0, @_) }
  2662. sub head_http4 { do_httpx4(HEAD => 0, @_) }
  2663.  
  2664. # Either https or http
  2665.  
  2666. sub get_httpx  { do_httpx2(GET  => @_) }
  2667. sub post_httpx { do_httpx2(POST => @_) }
  2668. sub put_httpx  { do_httpx2(PUT  => @_) }
  2669. sub head_httpx { do_httpx2(HEAD => @_) }
  2670.  
  2671. sub get_httpx3  { do_httpx3(GET  => @_) }
  2672. sub post_httpx3 { do_httpx3(POST => @_) }
  2673. sub put_httpx3  { do_httpx3(PUT  => @_) }
  2674. sub head_httpx3 { do_httpx3(HEAD => @_) }
  2675.  
  2676. sub get_httpx4  { do_httpx4(GET  => @_) }
  2677. sub post_httpx4 { do_httpx4(POST => @_) }
  2678. sub put_httpx4  { do_httpx4(PUT  => @_) }
  2679. sub head_httpx4 { do_httpx4(HEAD => @_) }
  2680.  
  2681. ### Legacy, don't use
  2682. # ($page, $respone_or_err, %headers) = do_https(...);
  2683.  
  2684. sub do_https {
  2685.     my ($site, $port, $path, $method, $headers,
  2686.     $content, $mime_type, $crt_path, $key_path) = @_;
  2687.  
  2688.     do_https2($method, $site, $port, $path, $headers,
  2689.          $content, $mime_type, $crt_path, $key_path);
  2690. }
  2691.  
  2692. 1;
  2693. __END__
  2694.